Top> よくつかうプログラム> プログラムの短縮

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

プログラムの短縮

プログラムを短くしよう

プログラムは短い方がわかりやすいし修正も容易になります。
基礎がわかればプログラムを短くする方法を考えていきましょう。

1)ブックの中での処理

プログラムの短縮

大阪・名古屋・東京・福岡のシートを準備しましょう。
各シートの決まった場所(セル)に文字を入力するプログラムを考えていきましょう。
Sub 短縮()
  Worksheets("大阪").Cells(1, 1) = "aaaaa"
  Worksheets("名古屋").Cells(1, 1) = "aaaaa"
  Worksheets("東京").Cells(1, 1) = "aaaaa"
  Worksheets("福岡").Cells(1, 1) = "aaaaa"
End Sub
Sub 解除()
  Worksheets("大阪").Cells(1, 1) = ""
  Worksheets("名古屋").Cells(1, 1) = ""
  Worksheets("東京").Cells(1, 1) = ""
  Worksheets("福岡").Cells(1, 1) = ""
End Sub
大阪・名古屋・東京・福岡のシートの名前をプログラムに直接書くのではなく、シートのデータを活用しましょう。
営業所シートを準備してください。

プログラムの短縮

ポイントは営業所名を変数を使って代入することです、その後その変数を使ってシート名にしている所です。
Sub 短縮1()
  Dim lastrow As Long
  Dim i As Long
  Dim eigyousyo As String
  lastrow = Worksheets("営業所").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    eigyousyo = Worksheets("営業所").Cells(i, 1)
    Worksheets(eigyousyo).Cells(1, 1) = "aaaaa"
  Next
End Sub
Sub 解除1()
  Dim lastrow As Long
  Dim i As Long
  Dim eigyousyo As String
  lastrow = Worksheets("営業所").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    eigyousyo = Worksheets("営業所").Cells(i, 1)
    Worksheets(eigyousyo).Cells(1, 1) = ""
  Next
End Sub

2)他のブックを利用する処理

別の場所(フォルダー)にある大阪・東京・名古屋のブックに次の同じ作業を処理します。
更新月のシート名を作り前月シートの当月残高を前月残に更新し翌月シートに転記する処理です。

プログラムの短縮

Sub 更新()
  Dim nentuki As String
  Dim yoku As Long
  Dim yokumoji As String
  Dim i As Long
  Dim lastrow As Long
  nentuki = InputBox("更新年月例201401")
  yoku = yokugetu(nentuki)
'大阪の処理
  Workbooks.Open "D:\更新の自動\大阪.xlsx"
  Worksheets.Add after:=Worksheets(nentuki)
  ActiveSheet.Name = yoku
  yokumoji = ActiveSheet.Name
'シートに翌月の名前をつける
  Worksheets(yokumoji).Cells(1, 1) = "前月残"
  Worksheets(yokumoji).Cells(1, 2) = "当月売上"
  Worksheets(yokumoji).Cells(1, 3) = "前月残"
  Worksheets(yokumoji).Cells(1, 4) = "当月残高"
'前月シートの当月残高を前月残に更新
  lastrow = Worksheets(nentuki).Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    Worksheets(yokumoji).Cells(i, 1) = Worksheets(nentuki).Cells(i, 4)
  Next
  Application.DisplayAlerts = False
  ActiveWorkbook.Close SaveChanges:=True
  Application.DisplayAlerts = True
'名古屋の処理
  Workbooks.Open "D:\更新の自動\名古屋.xlsx"
  Worksheets.Add after:=Worksheets(nentuki)
  ActiveSheet.Name = yoku
  yokumoji = ActiveSheet.Name
'シートに翌月の名前をつける
  Worksheets(yokumoji).Cells(1, 1) = "前月残"
  Worksheets(yokumoji).Cells(1, 2) = "当月売上"
  Worksheets(yokumoji).Cells(1, 3) = "前月残"
  Worksheets(yokumoji).Cells(1, 4) = "当月残高"
'前月シートの当月残高を前月残に更新
  lastrow = Worksheets(nentuki).Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    Worksheets(yokumoji).Cells(i, 1) = Worksheets(nentuki).Cells(i, 4)
  Next
  Application.DisplayAlerts = False
  ActiveWorkbook.Close SaveChanges:=True
  Application.DisplayAlerts = True
'東京の処理
  Workbooks.Open "D:\更新の自動\東京.xlsx"
  Worksheets.Add after:=Worksheets(nentuki)
  ActiveSheet.Name = yoku
  yokumoji = ActiveSheet.Name
'シートに翌月の名前をつける
  Worksheets(yokumoji).Cells(1, 1) = "前月残"
  Worksheets(yokumoji).Cells(1, 2) = "当月売上"
  Worksheets(yokumoji).Cells(1, 3) = "前月残"
  Worksheets(yokumoji).Cells(1, 4) = "当月残高"
'前月シートの当月残高を前月残に更新
  lastrow = Worksheets(nentuki).Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    Worksheets(yokumoji).Cells(i, 1) = Worksheets(nentuki).Cells(i, 4)
  Next
  Application.DisplayAlerts = False
  ActiveWorkbook.Close SaveChanges:=True
  Application.DisplayAlerts = True
End Sub
Function yokugetu(nentuki As String)
  yokugetu = Val(nentuki) + 1
End Function
yokugetu関数を使って翌月を計算(+1)しています。
短縮形
大阪・東京・名古屋と同じ処理を3つ書いていますのでそれを1つにまとめています。
営業所シートを使ってそのデータをブック名の変数に代入して使っています。
何を繰り返すかがポイントです。
Sub 更新短縮()
  Dim nentuki As String
  Dim yoku As Long
  Dim yokumoji As String
  Dim i As Long
  Dim j As Long
  Dim lastrow As Long
  Dim eigyousyo As String
  Dim eigyoupath As String
  nentuki = InputBox("更新年月例201401")
  yoku = yokugetu(nentuki)
  lastrow = Worksheets("営業所").Cells(Rows.Count, 1).End(xlUp).Row
  For j = 2 To lastrow
    eigyousyo = Worksheets("営業所").Cells(j, 1)
    eigyoupath = "D:\更新の自動\" & eigyousyo & ".xlsx"
    Workbooks.Open eigyoupath
    Worksheets.Add after:=Worksheets(nentuki)
    ActiveSheet.Name = yoku
    yokumoji = ActiveSheet.Name
'シートに翌月の名前をつける
    Worksheets(yokumoji).Cells(1, 1) = "前月残"
    Worksheets(yokumoji).Cells(1, 2) = "当月売上"
    Worksheets(yokumoji).Cells(1, 3) = "前月残"
    Worksheets(yokumoji).Cells(1, 4) = "当月残高"
'前月シートの当月残高を前月残に更新
    lastrow = Worksheets(nentuki).Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
      Worksheets(yokumoji).Cells(i, 1) = Worksheets(nentuki).Cells(i, 4)
    Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Close SaveChanges:=True
    Application.DisplayAlerts = True
  Next
End Sub

 

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)