【マクロ・VBA】フォルダ内のファイルをインデックス・マッチで全てインポートかつ突合する

Sub フォーマットインポート_フォルダの全て_エクセルファイルとCSVファイルを処理()  '列行指定（インデックスマッチ）

Worksheets.Add(After:=ActiveSheet).Name = "import_"
'Worksheets.Add(After:=ActiveSheet).Name = ActiveSheet.Name & "_" & VBA.Format(Now(), "h時mm分ss秒")

'このファイル
Dim ws1 As Worksheet    'Set ws1 = ActiveSheet
Set ws1 = ThisWorkbook.Worksheets("import_")

'対象ファイル(フォーマットファイルをインポート)
Dim FName As String
Dim wb1000 As Workbook
Dim ws1000 As Worksheet

MsgBox "「ファイル」選択"
FName = Application.GetOpenFilename("Microsoft ExcelブックorＣＳＶ,*.*")  ' "\*.*")

If FName <> "False" Then
    Set wb1000 = Workbooks.Open(FName)
    Set ws1000 = wb1000.Worksheets(1)
Else
    MsgBox "File未指定 "
End
End If

'表示系列変換
ws1000.Activate
ws1000.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, FieldInfo:=Array(1, xlTextFormat)
Selection.NumberFormatLocal = "@"

'インポート
ws1000.Cells.Copy ThisWorkbook.Worksheets("import_").Range("A1")

'コピーモード解除
Application.CutCopyMode = False

'閉じる
wb1000.Close savechanges:=False
Set wb1000 = Nothing
Set ws1000 = Nothing

'-------------------------------------------------------------------------------------------------
'まとめたいデータの入っているディレクトリのパスを代入
Const path As String = "C:\Users\y1ban\OneDrive\デスクトップ\Sampleフォルダ\"

'ディレクトリ内の全てのファイル名を取得
Dim buf As String
buf = Dir(path & "\*.*")

'ループ処理--------------------------------------------------------------------------------------
Dim i As Long
Do While buf <> ""
i = i + 1
 
 '相手シート
    Dim wb2 As Workbook
    Set wb2 = Workbooks.Open(path + buf)
    Dim ws2 As Worksheet
    Set ws2 = wb2.Worksheets(1)

'表示系列変換
    ws2.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, FieldInfo:=Array(1, xlTextFormat)  'おかしい
    Selection.NumberFormatLocal = "@"

    ActiveCell.Select
 
    ws2.Cells(1, 1) = ws1.Cells(1, 1).Value

  
'ディクショナリ作成-----------------
'Dictionaryオブジェクトの宣言
Dim dicGyoukoumoku As Object     '元表の社名行番号ディクショナリ
Dim dicRetukoumoku As Object     '元表の項目名列番号ディクショナリ

Set dicGyoukoumoku = CreateObject("Scripting.Dictionary")
Set dicRetukoumoku = CreateObject("Scripting.Dictionary")

Const ws2_KEY_CLM As Long = 1 '「元表」シートのキー列（社名列：C列）
Const ws2_KEY_ROW As Long = 1 '「元表」シートのキー行（項目見出し行:１行目）

Dim iRRow As Long        '元表シートの読込行(ws2)
Dim iRCol As Long        '元表シートの読込列(ws2)

        'あいて表シート（２行目から最終行）から社名のディクショナリを作成
        For iRRow = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
        'For iRRow = 2 To ws2.Cells(2, ws2_KEY_CLM).End(xlDown).Row
        DoEvents
        
            '社名をキーとして行番号をディクショナリに保管（同じ社名が複数存在した場合、後勝ちで行番号が上書きされます）
            dicGyoukoumoku(ws2.Cells(iRRow, "A").Value) = iRRow     '(ws2)
        Next
    
        'あいて表シート（2列目から最終列）から項目名のディクショナリを作成
        For iRCol = 2 To ws2.Cells(1, Columns.Count).End(xlToLeft).Column
        'For iRCol = 2 To ws2.Cells(ws2_KEY_ROW, 1).End(xlToRight).Column
        DoEvents
        
            '項目名をキーとして列番号をディクショナリに保管
            dicRetukoumoku(ws2.Cells(1, iRCol).Value) = iRCol
        Next


'転記処理----------------------------
Const ws1_CLM As Long = 1 '「転記先」シートA列（社名列：C列）
Const ws1_ROW As Long = 1 '「転記先」シート１行目（項目見出し行:１行目）

    Dim iWRow As Long        '転記先シートの出力行(ws1)
    Dim iWCol As Long        '転記先シートの出力列(ws1)


        'あいて転記先シート（5行目から最終行）の社名ループ
        For iWRow = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row                     '社名から元表の行番号を取得
        
        DoEvents
    
            If dicGyoukoumoku.Item(ws1.Cells(iWRow, ws1_CLM).Value) = "" Then         '社名から行番号が取得できない場合は何もしない
            Else
                iRRow = dicGyoukoumoku.Item(ws1.Cells(iWRow, ws1_CLM).Value)            '元表の行番号を取得
            End If
        
                'あいて転記先シートの項目ループ-------------
                For iWCol = 1 To ws1.Cells(1, Columns.Count).End(xlToLeft).Column              '項目名から元表の列番号を取得
                
                DoEvents
                    If dicRetukoumoku.Item(ws1.Cells(ws1_ROW, iWCol).Value) = "" Then          '項目名から列番号が取得できない場合は何もしない
                    Else
                        iRCol = dicRetukoumoku.Item(ws1.Cells(ws1_ROW, iWCol).Value)            '元表の列番号を取得
                        ws1.Cells(iWRow, iWCol).Value = ws2.Cells(iRRow, iRCol).Value      '「元表」シートの取得行・取得列のセルの値を、「転記先」シートの出力行・出力列に出力する
                    End If
                Next iWCol
        Next iWRow

    ActiveWorkbook.Close savechanges:=False  'ActiveWorkbook.Close savechanges:=True

buf = Dir()
Loop '----------------------DO LOOP

ThisWorkbook.Activate
'ws1.Range("A1").Select

MsgBox "完了"
End Sub