excelマクロ

Sub SampleCall()
' ここで対象にしたいシート名を指定するだけ！
' 将来的に "CCC", "DDD" を追加する場合もここを編集するだけでOKです。
Dim targetSheets As Variant
targetSheets = Array("AAA", "BBB")

Call ExecuteMatching(targetSheets)

End Sub

Sub ExecuteMatching(sheetNames As Variant)
Dim wsRef As Worksheet
Dim i As Long, j As Long, k As Long
Dim sheetName As Variant

' 設定値（必要に応じて変更してください）
Const MAX_REF As Long = 10000
Const MAX_DATA_ROW As Long = 3000 ' 各シートの読み込み上限（余裕を持たせた数値）

Set wsRef = ThisWorkbook.Sheets("参照")

' 参照シートのデータを一括取得
Dim RefZ As Variant, RefW As Variant
RefZ = wsRef.Range("Z1:Z" & MAX_REF).Value
RefW = wsRef.Range("W1:W" & MAX_REF).Value

' 結果を格納するコレクション（シートごとの結果配列を保持）
Dim resultsDict As Object
Set resultsDict = CreateObject("Scripting.Dictionary")

' --- 1. 各シートのデータを動的に読み込む ---
For Each sheetName In sheetNames
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    
    If Not ws Is Nothing Then
        ' シートごとのKeyと金額を読み込み（A列とX列を想定）
        ' ※列番号がシートごとに違う場合はここを条件分岐させます
        Dim dataKey As Variant, dataValue As Variant
        dataKey = ws.Range("A1:A" & MAX_DATA_ROW).Value
        dataValue = ws.Range("X1:X" & MAX_DATA_ROW).Value
        
        ' 参照行と同じサイズの結果配列を準備
        Dim resArray As Variant
        ReDim resArray(1 To MAX_REF, 1 To 1)
        
        ' --- 2. 検索ロジック ---
        For i = 1 To MAX_REF
            ' Z列の値が現在のループ対象シート名（AAA等）と一致する場合のみ処理
            If RefZ(i, 1) = sheetName Then
                For j = 1 To MAX_DATA_ROW
                    If dataKey(j, 1) = RefW(i, 1) Then
                        resArray(i, 1) = dataValue(j, 1)
                        Exit For
                    End If
                Next j
            End If
        Next i
        
        ' 結果をシート名をキーにして保存
        resultsDict.Add sheetName, resArray
    End If
Next sheetName

' --- 3. 完了通知（または結果の書き出し） ---
MsgBox "指定された " & UBound(sheetNames) + 1 & " つのシートの処理が完了しました。"

' 例：AAAの結果にアクセスする場合
' Dim finalAAA As Variant
' finalAAA = resultsDict("AAA")

End Sub