ファビコン。井の家紋。2ブックの表を照らし合わせて更新するマクロのテンプレート | エクセルマクロ(VBA)実践蔵(じっせんぐら)

前の項目 - エクセルマクロの基本(初級)その3
次の項目 - 持ち株の損益グラフを作成するマクロ

2ブックの表を照らし合わせて更新するマクロのテンプレート最終更新日:2023-06-17

下記の記事で使用した説明用の表を使用して、エクセルファイルを2つ開いて、2つの表のデータを比べて

更新するテストマクロを作成しました。エクセルマクロ中級編として、そして、2つのブックを開く、テンプレートにもなるかと思い、作ってみました。

ブックを2つ開いて、表を照合し、更新するマクロ(テンプレートになるかな)

マクロ有効ブックと同じ階層に「テストA.xlsx」ファイルと「テストB.xlsx」ファイルがある想定です。

テストAファイルとテストBファイルで表の構成を変えています。テストAファイルはシート名「Sheet1」をテストBファイルはシート名「Sheet2」を参照しています。

マクロ有効ブックで実行を行い、テストBファイルの更新を行い、テストAファイルは参照をします。テストBファイルの名前に登録されている名前と一致する名前をテストAファイルから探し、住所の更新を行います。(テストなので住所欄だけです。郵便番号欄は変えてません。)

 
Sub BookOpenAndReadWriteTest()

'変数宣言
Dim FileNameA As String, FileNameB As String
Dim pathA As String, pathB As String
Dim WbkA As Workbook, WbkB As Workbook
Dim WshtA As Worksheet, WshtB As Worksheet
Dim NameTitleARng As Range, NameTitleBRng As Range
Dim AddrsTitleARng As Range, AddrsTitleBRng As Range

Dim 名前列AのRngs As Range, 名前列BのRngs As Range
Dim oneARng As Range, oneBRng As Range
Dim AddressAStr As String, AddressBStr As String

FileNameA = "テストA.xlsx"
FileNameB = "テストB.xlsx"

'ThisWorkbook.pathは、マクロ有効ブックの格納フォルダパス
'そのpathと開くファイル名を連結させる
pathA = ThisWorkbook.path & "/" & FileNameA
pathB = ThisWorkbook.path & "/" & FileNameB

If Dir(pathA) <> "" And Dir(pathB) <> "" Then
'ファイルが存在する場合
Set WbkA = Workbooks.Open(pathA)
Set WbkB = Workbooks.Open(pathB)
Else
'いずれか又は両方のファイルが存在しない
MsgBox "ファイルが開けませんでした。"
Exit Sub
End If

'ブック内のシート数分でループ
For Each WshtA In WbkA.Worksheets
'Sheet1があるか確認
If WshtA.Name = "Sheet1" Then
Exit For
End If
Next

For Each WshtB In WbkB.Worksheets
'Sheet2があるか確認
If WshtB.Name = "Sheet2" Then
Exit For
End If
Next

'目当てのシートを見つけた
If Not WshtA Is Nothing And Not WshtB Is Nothing Then

'使われている行の一番上から表題(名前)のセル情報を取得
Set NameTitleARng = WshtA.UsedRange.Rows(1).Find("名前", LookAt:=xlWhole)
Set NameTitleBRng = WshtB.UsedRange.Rows(1).Find("名前", LookAt:=xlWhole)

Set AddrsTitleARng = WshtA.UsedRange.Rows(1).Find("住所", LookAt:=xlWhole)
Set AddrsTitleBRng = WshtB.UsedRange.Rows(1).Find("住所", LookAt:=xlWhole)

'表題から名前と住所をそれぞれ見つけたか確認
If Not NameTitleARng Is Nothing And Not NameTitleBRng Is Nothing And _
Not AddrsTitleARng Is Nothing And Not AddrsTitleBRng Is Nothing Then

'シートAの名前検索範囲を求める(Find用)
For Each 名前列AのRngs In WshtA.UsedRange.Columns
If 名前列AのRngs.Column = NameTitleARng.Column Then
'Aシートの名前の列数と一致する列情報を取得
Exit For
End If
Next

'シートBの名前欄の範囲を求める(For Each用)
For Each 名前列BのRngs In WshtB.UsedRange.Columns
If 名前列BのRngs.Column = NameTitleBRng.Column Then
'Bシートの名前の列数と一致する列情報を取得
Exit For
End If
Next

'シートBの名前数分ループ
For Each oneBRng In WshtB.Range(名前列BのRngs.Address)

If Not oneBRng.Row = NameTitleBRng.Row Then
'表題の行でなければ、

'Find関数で探す(Bシートの名前をAシートで探す)
Set oneARng = 名前列AのRngs.Find(oneBRng.Value, LookAt:=xlWhole)

'見つかったか確認する
If Not oneARng Is Nothing Then

'住所文字列をそれぞれ取得
AddressAStr = WshtA.Cells(oneARng.Row, AddrsTitleARng.Column).Value
AddressBStr = WshtB.Cells(oneBRng.Row, AddrsTitleBRng.Column).Value

'住所の比較
If StrComp(AddressAStr, AddressBStr, vbTextCompare) = 0 Then
'一致する
Else
'一致しない
'Aの情報をBへ設定する
WshtB.Cells(oneBRng.Row, AddrsTitleBRng.Column).Value = AddressAStr
Debug.Print "テストBファイルのSheet2の更新位置:" & WshtB.Cells(oneBRng.Row, AddrsTitleBRng.Column).Address

End If '住所の比較

End If 'Find結果確認

End If '表題以外の行

Next '次の名前を取得

Else ' 表題から名前と住所が見つけられない

MsgBox "名前又は住所の欄が見つかりませんでした。"

End If

Else '目当てのシートが見つからない

MsgBox "シートが見つかりませんでした。"

End If

'開いたブックを保存して閉じる
WbkA.Close
WbkB.Close SaveChanges:=True

'メモリ解放
Set WbkA = Nothing
Set WbkB = Nothing
Set WshtA = Nothing
Set WshtB = Nothing
Set NameTitleARng = Nothing
Set NameTitleBRng = Nothing
Set AddrsTitleARng = Nothing
Set AddrsTitleBRng = Nothing
Set 名前列AのRngs = Nothing
Set 名前列BのRngs = Nothing
Set oneARng = Nothing
Set oneBRng = Nothing

End Sub

ブックが2つになると変数が多くなりました。

作るだけ作ったので載せてみました。

UsedRangeを使用して使用されているセル範囲のみを参照しています。

上のコードを動作させるには「使用されているセルの一行目が表題である」という条件と、各シートに表が一つという条件がつきます。

表題の位置が変わるなら「Rows(1)」の部分を変更する必要があります。

また、複数の表や情報が記述されているシートなら、表の範囲の判断が別で必要です。

初級編の延長で書いていたので、UsedRangeとFor Eachを使用しています。

ブックを2つ開いて、表を照合し、更新するマクロの解説

表題から名前の欄と住所の欄をそれぞれのブックのシートから列の特定を行います。

列が特定できたら、名前の列の使用されているセル範囲を求めています。

Bファイルの名前数分ループし、Aファイルの名前欄で検索(Find関数)を使用しています。

一致する位置の住所の比較を行い、更新が必要なら、AファイルからBファイルへ情報を移しています。

前の項目 - エクセルマクロの基本(初級)その3
次の項目 - 持ち株の損益グラフを作成するマクロ