(14)プログラムを短くしよう
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"
' MsgBox yokugetu(nentuki)
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