Excel VBAで転記する方法
VBAを活用する場面では、ExcelからExcelへの転記ではないでしょうか。この転記ができると、業務短縮がはかれるようになります。少しずづ解説していきます。
例題
以下の売上管理表から、利益集計表に転記する例で説明します。
売上管理表の20個の売上データを、行に品目・列に仕入れ日をいれた表に、利益を入れるマクロを作成しました。
転記元と転記先とマクロのファイルは、別々に
マクロのファイルは、転記対象と別にしておいた方が、マクロブックが、増加しなくて、管理が楽だと思っています。
マクロブックに、マクロを記入するシートを作りましょう。といっても、空白のシートの名前を、「マクロ」にする程度で完了です。
転記元と転記先ファイルの指定
色々な指定方法がありしますが、シート「マクロ」に、ファイルのフルパスを記載して指定するようにします。
Range(“C4”)に「転記元ファイル」の名前をつけ、ファイルのフルパスを設定します。
同様に、Range(“C6”)に「転記元ファイル」の名前をつけ、ファイルのフルパスを設定します。
「C:\TEMP\」に、「売上管理表」と「利益集計表」を保管しましょう。
以下がマクロの全体です。
シートモジュールに記載しています。理由は、以下のリンク先を参照してください。
https://blogvba.com/sheetmodule/
Option Explicit
' モジュールレベル変数
Private wbFrom As Workbook ' 転記元ブック
Private wsFrom As Worksheet ' 転記元シート
Private wbTo As Workbook ' 転記先ブック
Private wsTo As Worksheet ' 転記先シート
Private 日付 As Date
Private 品目 As String
Private 利益 As Long
Sub 転記()
Call ブックとシートをセット
Call 転記先のデータをクリア
Call 転記元から転記先に転記
End Sub
Sub ブックとシートをセット()
' Workbooks.Openと同時に変数wbに格納する
' https://vba-create.jp/vba-tips-simple-set-wb/
' 転記元は、変更しないので、リードオンリーで開く
Set wbFrom = Workbooks.Open(Range("転記元ファイル"), ReadOnly:=True)
' シートのセット。ワークシートが一つなので、インデックスで指定。
Set wsFrom = wbFrom.Worksheets(1)
' 以下、転記先も同様。ただし、ロードオンリーではない
Set wbTo = Workbooks.Open(Range("転記先ファイル"))
Set wsTo = wbTo.Worksheets(1)
End Sub
Sub 転記先のデータをクリア()
wsTo.Range("C4:AG7").ClearContents ' 値と数式をクリア、書式などは残す
End Sub
Sub 転記元から転記先に転記()
' 転記元の処理をまとめる
With wsFrom
Dim rwLast As Long ' B列の最後の行
rwLast = .Cells(Rows.Count, "B").End(xlUp).Row
' 3行目から最後の行まで繰り返す
Dim rw As Long ' 行
For rw = 3 To rwLast
日付 = .Cells(rw, "C")
品目 = .Cells(rw, "B")
利益 = .Cells(rw, "F")
Call 転記先に利益を入れる
Next rw
End With
End Sub
Sub 転記先に利益を入れる()
Dim 品目有 As Boolean: 品目有 = False ' 転記先に品目が有る⇒True
Dim 日付有 As Boolean: 日付有 = False ' 転記先に日付が有る⇒True
' 転記先の処理をまとめる
With wsTo
Dim rwLast As Long ' B列の最後の行
rwLast = .Cells(Rows.Count, "B").End(xlUp).Row
' 4行目から最後の行まで繰り返す
Dim rw As Long ' 行
For rw = 4 To rwLast
' 品目があった場合
If .Cells(rw, "B") = 品目 Then
品目有 = True
Dim rwTrue As Long
rwTrue = rw
Exit For
End If
Next rw
Dim clmLast As Long ' 3行の最後の列
clmLast = .Cells(3, Columns.Count).End(xlToLeft).Column
' 3列目から最後の列まで繰り返す
Dim clm As Long ' 列
For clm = 3 To clmLast
' 日付があった場合
If .Cells(3, clm) = 日付 Then
日付有 = True
Dim clmTrue As Long
clmTrue = clm
Exit For
End If
Next clm
' 品目も日付もあった場合、利益を入れる
If 品目有 And 日付有 Then
.Cells(rwTrue, clmTrue) = 利益
End If
End With
End Subこのマクロを実行すると、利益集計表は、以下の通り、売上管理表のデータが転記されました。
以下で変数を設定しています。プロシージャを分割するので、モジュールレベル変数を設定しています。
' モジュールレベル変数
Private wbFrom As Workbook ' 転記元ブック
Private wsFrom As Worksheet ' 転記元シート
Private wbTo As Workbook ' 転記先ブック
Private wsTo As Worksheet ' 転記先シート
Private 日付 As Date
Private 品目 As String
Private 利益 As Long以下がメインのプロシージャで、３つのプロシージャを順番に呼び出しています。
Sub 転記()
Call ブックとシートをセット
Call 転記先のデータをクリア
Call 転記元から転記先に転記
End Sub以下、開くブックは、シート「マクロ」に、事前に記入しておきます。ブックを開くと同時に、セットしています。その後、シートのセットして、あとは、転記元シート「wsFrom」と転記先シート「wsTo」を使用します。
Sub ブックとシートをセット()
' Workbooks.Openと同時に変数wbに格納する
' https://vba-create.jp/vba-tips-simple-set-wb/
' 転記元は、変更しないので、リードオンリーで開く
Set wbFrom = Workbooks.Open(Range("転記元ファイル"), ReadOnly:=True)
' シートのセット。ワークシートが一つなので、インデックスで指定。
Set wsFrom = wbFrom.Worksheets(1)
' 以下、転記先も同様。ただし、ロードオンリーではない
Set wbTo = Workbooks.Open(Range("転記先ファイル"))
Set wsTo = wbTo.Worksheets(1)
End Sub次に、転記先のデータをクリアしています。特に必要のない処理ですが、クリアした方が、デバックが楽になるので、入れています。
Sub 転記先のデータをクリア()
wsTo.Range("C4:AG7").ClearContents ' 値と数式をクリア、書式などは残す
End Sub次は、転記元の処理を記載しています。3行目から最後の行まで繰り返して、「日付」「品目」「利益」を取得して、次のプロシージャ「転記先に利益を入れる」を呼び出してます。
Sub 転記元から転記先に転記()
' 転記元の処理をまとめる
With wsFrom
Dim rwLast As Long ' B列の最後の行
rwLast = .Cells(Rows.Count, "B").End(xlUp).Row
' 3行目から最後の行まで繰り返す
Dim rw As Long ' 行
For rw = 3 To rwLast
日付 = .Cells(rw, "C")
品目 = .Cells(rw, "B")
利益 = .Cells(rw, "F")
Call 転記先に利益を入れる
Next rw
End With
End Sub以下の「品目有」と「日付有」は、あとの処理で、品目や日付が、転記先にあった場合に、Trueにしている。
Sub 転記先に利益を入れる()
Dim 品目有 As Boolean: 品目有 = False ' 転記先に品目が有る⇒True
Dim 日付有 As Boolean: 日付有 = False ' 転記先に日付が有る⇒True
以下、4行目から最後の行まで、繰り返し、「品目」があった場合、その行を、「rwTrue」に入れている。また、「品目有」をTrueにして、forループを終了させている。
' 転記先の処理をまとめる
With wsTo
Dim rwLast As Long ' B列の最後の行
rwLast = .Cells(Rows.Count, "B").End(xlUp).Row
' 4行目から最後の行まで繰り返す
Dim rw As Long ' 行
For rw = 4 To rwLast
' 品目があった場合
If .Cells(rw, "B") = 品目 Then
品目有 = True
Dim rwTrue As Long
rwTrue = rw
Exit For
End If
Next rw以下、3行列から最後の列まで、繰り返し、「日付」があった場合、その列を、「clmTrue」に入れている。また、「日付有」をTrueにして、forループを終了させている。
Dim clmLast As Long ' 3行の最後の列
clmLast = .Cells(3, Columns.Count).End(xlToLeft).Column
' 3列目から最後の列まで繰り返す
Dim clm As Long ' 列
For clm = 3 To clmLast
' 日付があった場合
If .Cells(3, clm) = 日付 Then
日付有 = True
Dim clmTrue As Long
clmTrue = clm
Exit For
End If
Next clm以下、品目があり、日付もあった場合、該当セルに、「利益」を入れる。これで、終了です。
' 品目も日付もあった場合、利益を入れる
If 品目有 And 日付有 Then
.Cells(rwTrue, clmTrue) = 利益
End If
End With
End Subファイルは、以下からダウンロードしてください。
Follow me!
