シート名の参照として列見出しを使用する

Question

特定の製品コード（列a）の値を1週間に対応するように検索したい（行1に数値が記載されています）。週コード（1行目）は、ここに表示されているとおり、毎週のシートを持つワークブックを参照します。私はそのワークブックに行き、正しいシートにアクセスし、製品コードを見つけて、列Lから対応するセルを引き出したいと思います。これを書く方法はわかりません。
私は約500週間のコードと500の製品コードを持っているので、マクロが必要だと思っています。

例：セルB2では、NPPPに対応する「Combined Performance Tracking.xlsx」のシート40111、列Lからデータを探したいとします。

私はこれまでに書かれているが、私はそれを実行したときに、私のインデックスマッチが問題として白羽されます。任意のアイデアをどのようにこれを修正するには？

Sub populate() 
Dim ws As Worksheet 
Dim count 
Dim count2 
Dim stock_code 
Dim rep 
Dim sheet_name As String 

ws = Sheets("Sheet3") 

For count = 2 To 140 
    sheet_name = ws.Cells(1, count) 

    For count2 = 2 To 873 
     stock_code = ws.Cells(count2, 1) 
     Workbooks("Combined Performance tracking.xlsx").Activate 
      For rep = 1 To (Worksheets.count) 
       If sheet_name = Sheets(rep).Name Then 
         index($a$5:$az$800, match(stock_code, $A$5:$A$800, 0), match("uber", $a$5:$az$5, 0) 
        ActiveCell.Select 
        ActiveCell.Copy 
        Workbooks("Jody Project Final.xlsm").Activate 
        Worksheets("sheet3").Cells(count2, count).Activate 
        ActiveCell.Select 
        ActiveCell.Paste 
         End If 
      Next 
    Next 
Next 
End Sub 

Answer 1

SQLは、ADOを使用して別のブックからテーブルを結合する必要はありません。私は、1つのテーブルをExcelの多くのテーブルと比較するときにスクリプト辞書を使用することを好みます。

（500製品）= 25000には、ルックアップと割り当てごとの操作数を掛け合わせると、おそらく100,000を超える操作になります。 EXCEL VLOOKUP VS INDEX MATCH VS SQL VS VBAベンチはさまざまな方法をテストします。その記事に基づいて私のマクロは3〜7秒かかるでしょう。それが動作し、実行にどれくらい時間がかかるか教えてください。

Sub FillProductPrices() 
    ToggleEvents False 

    Dim dProducts 
    Dim wsLookup As Worksheet 
    Dim arSheetNames, arProducts, arValues, arLookUp 
    Dim x As Long, y As Long, count As Long, i As Long 
    Dim k As String, SheetName As String 
    Dim wbTarget As Worksheet 
    Dim wbDataSource As Workbook 

    Set wbDataSource = Workbooks.Open("Combined Performance tracking.xlsx") 

    Set wbTarget = Sheets("Sheet3") 

    Set dProducts = CreateObject("Scripting.Dictionary") 

    With wbTarget 
     arProducts = .Range("A2", .Range("A2").End(xlDown)).Value 
     arSheetNames = .Range("B1", .Range("B1").End(xlToRight)).Value 
     count = UBound(arProducts, 1) 
    End With 

    For i = 1 To count 
     k = UCase(Trim(arProducts(i, 1))) 
     If Not dProducts.Exists(k) Then dProducts.Add k, i 
    Next 

    For y = 1 To UBound(arSheetNames, 2) 
     On Error Resume Next 
     SheetName = arSheetNames(1, y) 
     Set wsLookup = wbDataSource.Worksheets(SheetName) 
     If Err.Number = 0 Then 
      With wsLookup 
       ReDim arValues(1 To count, 1 To 1) As Double 
       arProducts = .Range("A2", .Range("A2").End(xlDown)).Value 
       arLookUp = .Range("L2", .Range("L" & Rows.count).End(xlUp)).Value 
      End With 

      For x = 1 To count 
       k = UCase(Trim(arProducts(x, 1))) 
       If dProducts.Exists(k) Then 
        i = dProducts(k) 
        arValues(i, 1) = arLookUp(x, 1) 
       End If 
      Next 

      wbTarget.Cells(2, y + 1).Resize(count) = arValues 
     Else 
      Debug.Print SheetName & " not found" 
      Err.Clear 
     End If 
     On Error GoTo 0 

    Next 

    ToggleEvents True 
End Sub 

Sub ToggleEvents(EnableEvents As Boolean) 
    With Application 
     .ScreenUpdating = EnableEvents 
     .Calculation = IIf(True, xlCalculationAutomatic, xlCalculationManual) 
    End With 
End Sub