Question

我想查找特定产品代码（列a）的值，因为它对应于一周（在第1行中数字列出）。周代码（在第1行中）是指每周都有一张工作表的工作簿，与此处显示的完全相同。我想转到该工作簿，访问正确的工作表，找到产品代码，然后从L列中提取相应的单元格。我不确定如何写这个。
我有大约500周的代码和500个产品代码，所以我认为需要一个宏。

如果它有用的示例：在单元格B2中，我想要找到来自工作表40111，L列上的数据＆＃34; Combined Performance Tracking.xlsx＆＃34;与NPPP相对应。

worksheet

到目前为止，我已经写过了这个，但是当我运行它时，我的索引匹配被挑出来作为一个问题。任何想法如何解决这个问题？

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连接起来。在Excel中将1个表与多个表进行比较时，我更喜欢使用脚本字典。

（500周）*（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

使用列标题作为工作表名称的查找

1 个答案: