VB 二つのエクセルファイルを指定した列データだけを抜き出し1つのエクセルファイルにする

Question

VB初心者です。
二つのエクセルファイルを指定した列データだけを抜き出し1つのエクセルファイルにする方法が上手くいかず困っています。

A.xlsm : ID　種類　所属　ファイル名

B.xlsm : ファイル名　データ1　データ2　データ3　データ4　データ5　データ6

上記のような項目でデータがあるのですが、
まとめたとき、下記のようにしなければなりません

C.xlsm： ID　URL　データ1　データ2　データ3　データ5

ファイル名を主キーにして、引っ張らなければならないという事までは分かるのですが、
その後、どのように記述していいものか、わかりません。


今の説明も、うまくお伝えできているか変わりませんが
お分かりになる方がいましたら、お教えいただけないでしょうか。

tatsu99 · Accepted Answer

前回のは破棄してください。2万件なので、画面表示を抑止しました。
Const folder As String = "d:\goo\excel\goo251"
は、A.xlsmとB.xlsmを格納したフォルダ名です。あなたの環境にあわせて適切に設定して下さい。
-----------------------------------
Option Explicit
Public Sub まとめ()
    Const folder As String = "d:\goo\excel\goo251"
    Const bookA As String = "IDlist.xlsm"
    Const bookB As String = "Datalist.xlsm"
    Dim dicT As Object
    Dim row As Long
    Dim row3 As Long
    Dim maxrowA As Long
    Dim maxrowB As Long
    Dim sh As Worksheet
    Dim key As Variant
    Dim dt1 As Variant
    Dim dt2 As Variant
    Dim dt3 As Variant
    Dim dt4 As Variant
    Dim dt5 As Variant
    Application.ScreenUpdating = False
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Workbooks.Open Filename:=folder & "\" & bookA
    Workbooks.Open Filename:=folder & "\" & bookB
    Workbooks(bookB).Activate
    Set sh = Worksheets("Sheet1")
    'BookBの最終行を求め、最終行まで繰り返す
    maxrowB = sh.Cells(Rows.Count, 1).End(xlUp).row
    For row = 1 To maxrowB
        key = sh.Cells(row, 1).Value
        dt1 = sh.Cells(row, 2).Value
        dt2 = sh.Cells(row, 3).Value
        dt3 = sh.Cells(row, 4).Value
        dt4 = sh.Cells(row, 5).Value
        dt5 = sh.Cells(row, 6).Value
        dicT(key) = Array(dt1, dt2, dt3, dt4, dt5)
    Next
    ThisWorkbook.Worksheets("Sheet1").Cells.Clear
    Workbooks(bookA).Activate
    'BookAの最終行を求め、最終行まで繰り返す
    Set sh = Worksheets("Sheet1")
    maxrowA = sh.Cells(Rows.Count, 1).End(xlUp).row
    row3 = 1
    For row = 1 To maxrowA
        ThisWorkbook.Worksheets("Sheet1").Cells(row3, 1).Value = sh.Cells(row, 1).Value 'ID
        ThisWorkbook.Worksheets("Sheet1").Cells(row3, 2).Value = sh.Cells(row, 2).Value '種類
        key = sh.Cells(row, 4).Value
        'ファイル名が存在すれば
        If dicT.exists(key) = True Then
            'データ１～データ５を設定
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 3).Value = dicT(key)(0)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 4).Value = dicT(key)(1)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 5).Value = dicT(key)(2)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 6).Value = dicT(key)(3)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 7).Value = dicT(key)(4)
        End If
        row3 = row3 + 1
    Next
    Workbooks(bookA).Close
    Workbooks(bookB).Close
    Application.ScreenUpdating = True
    MsgBox ("完了")
End Sub

tatsu99 · Answer

以下、補足要求です。
１）３つのブックは既に、開いてある（オープンしてある）という前提で良いですか。（A.xlsm,B.xlsm,C.xlsm）
又、実際のブック名も、この名称でOKですか。

２）C.xlsmにまとめるとき、データ６はまとめなくて良いのですか？

３）３つのブックのシート名は何ですか。（それとも、全てSheet1の前提で良いですか）

４）３つのブックのデータは1行目が見出しで、2行目から実際のデータがあるという前提で良いですか。

５）マクロを格納するのは、どのブックですか。

tatsu99 · Answer

すみません。1点、確認もれがありました。

C.xlsm： ID　URL　データ1　データ2　データ3　データ5
上記のB列のURLは、どのようにして取得すればよいのでしょうか。

tatsu99 · Answer

追加の質問です。
A.xlsmは約何行ありますか。（もしデータ量が多いなら実行時、画面更新を抑止します）

tatsu99 · Answer

以下のマクロを標準モジュールへ登録してください。
    Const folder As String = "d:\goo\excel\goo251"
は、A.xlsmとB.xlsmを格納したフォルダ名です。あなたの環境にあわせて適切に設定して下さい。
もし、データが大量にあり、処理時間がかかる場合は、その旨補足ください。（多少は改善できます）
一般的に、このようなケースの場合は、連想配列(Dictionary)を使用すると効率がよいです。
VBA Dictionary で検索すると使用例が出てきます。（参考まで）
------------------------------------------------------------
Option Explicit
Public Sub まとめ()
    Const folder As String = "d:\goo\excel\goo251"
    Const bookA As String = "IDlist.xlsm"
    Const bookB As String = "Datalist.xlsm"
    Dim dicT As Object
    Dim row As Long
    Dim row3 As Long
    Dim maxrowA As Long
    Dim maxrowB As Long
    Dim sh As Worksheet
    Dim key As Variant
    Dim dt1 As Variant
    Dim dt2 As Variant
    Dim dt3 As Variant
    Dim dt4 As Variant
    Dim dt5 As Variant
    
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Workbooks.Open Filename:=folder & "\" & bookA
    Workbooks.Open Filename:=folder & "\" & bookB
    Workbooks(bookB).Activate
    Set sh = Worksheets("Sheet1")
    'BookBの最終行を求め、最終行まで繰り返す
    maxrowB = sh.Cells(Rows.Count, 1).End(xlUp).row
    For row = 1 To maxrowB
        key = sh.Cells(row, 1).Value
        dt1 = sh.Cells(row, 2).Value
        dt2 = sh.Cells(row, 3).Value
        dt3 = sh.Cells(row, 4).Value
        dt4 = sh.Cells(row, 5).Value
        dt5 = sh.Cells(row, 6).Value
        dicT(key) = Array(dt1, dt2, dt3, dt4, dt5)
    Next
    ThisWorkbook.Worksheets("Sheet1").Cells.Clear
    Workbooks(bookA).Activate
    'BookAの最終行を求め、最終行まで繰り返す
    Set sh = Worksheets("Sheet1")
    maxrowA = sh.Cells(Rows.Count, 1).End(xlUp).row
    row3 = 1
    For row = 1 To maxrowA
        ThisWorkbook.Worksheets("Sheet1").Cells(row3, 1).Value = sh.Cells(row, 1).Value 'ID
        ThisWorkbook.Worksheets("Sheet1").Cells(row3, 2).Value = sh.Cells(row, 2).Value '種類
        key = sh.Cells(row, 4).Value
        'ファイル名が存在すれば
        If dicT.exists(key) = True Then
            'データ１～データ５を設定
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 3).Value = dicT(key)(0)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 4).Value = dicT(key)(1)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 5).Value = dicT(key)(2)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 6).Value = dicT(key)(3)
            ThisWorkbook.Worksheets("Sheet1").Cells(row3, 7).Value = dicT(key)(4)
        End If
        row3 = row3 + 1
    Next
    Workbooks(bookA).Close
    Workbooks(bookB).Close
    MsgBox ("完了")
End Sub

めぐみん_ · Answer

＞エクセルの最大行数ぎりぎりまで件数があります。

データベースに切り替えた方がよいのでは？
SQL文使えば楽だと思いますし、どうしてもExcelに結果が欲しいなら
CSV形式で吐き出せば良いかと。

Excelの行数は確かに最大まで使えるかもですけど、
A＋Bを開いて配列も使ってCに書き込むって、
メモリの消費心配しちゃうしBookの破損も・・・

めぐみん_ · Answer

No.6です。

Aが２万で
Bが最大行数って事は、

・BにはAに存在しないファイル名がある
・Bには『重複して』ファイル名がある

によっても違いますしね。
特に後者の場合、『重複』している際のデータの扱いがどうなるのか？
たまに『数値を加算したい』とか「最大（最小）値を求めたい』とか「平均値を出したい』とか、
要望はありますので気になりますね。

VB 二つのエクセルファイルを指定した列データだけを抜き出し1つのエクセルファイルにする

以下、補足要求です。

すみません。

追加の質問です。

以下のマクロを標準モジュールへ登録してください。

前回のは破棄してください。

＞エクセルの最大行数ぎりぎりまで件数があります。

No.6です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング