Question

我有以下代码来查找属于单元格C3中的值的值（并进一步向下查找）：

aantalrijen = .Range("A2", .Range("A2").End(xlDown)).Cells.Count
    For I = 2 To aantalrijen + 1
        For J = 108 To 112
            For Each cell In .Range(.Cells(2, J), .Cells(aantalrijen, J)).Cells
                cell.Value = Application.VLookup(.Cells(I, 3), Sheets("omzet").Range("C:DH"), J - 2, 0)
            Next cell
        Next J
    Next I

我知道这不是获得所需结果的最有效方法。我应该如何调整代码以使其最有效？

更新：

现在我对这个结果感到满意：

aantalrijen = .Range("A2", .Range("A2").End(xlDown)).Cells.Count
    For J = 108 To 112
        For I = 2 To aantalrijen
            .Cells(I, J).Value = Application.VLookup(.Cells(I, 3), Sheets("omzet").Range("C:DH"), J - 2, 0)
        Next I
    Next J

End With

现在对我来说已经足够快了，它返回了想要的结果。

Answer 1

这里：

Option Explicit
Sub Test()

    Dim arrSource, arrData, i As Long, j As Long, ColI As Long, ColF As Long
    Dim DictMatches As New Scripting.Dictionary
    Dim DictHeaders As New Scripting.Dictionary

    With ThisWorkbook
        arrSource = .Sheets("omzet").UsedRange.Value
        arrData = .Sheets("SheetName").UsedRange.Value 'change this for the worksheet you are working on
    End With

    For i = 1 To UBound(arrSource, 2) 'this will store the headers position
        DictHeaders.Add arrSource(1, i) 'this will throw an error if you have any duplicate headers
    Next i

    For i = 2 To UBound(arrSource) 'this will store the row position for each match
        DictMatches.Add arrSource(i, 3), i 'this will throw an error if you have any duplicates
    Next i

    'Here you can change where you want to evaluate your data
    ColI = 108
    ColF = 112

    For i = 2 To UBound(arrData) 'loop through rows
        For j = ColI To ColF 'loop through columns
            arrData(i, j) = arrSource(DictMatches(arrData(i, 3), DictHeaders(1, j)))
        Next j
    Next i

    'Paste the arrData back to the sheet
    ThisWorkbook.Sheets("SheetName").UsedRange.Value = arrData

End Sub

这是最快的方法，为什么？

您将两个工作表都存储到数组中，然后再仅使用数组（这意味着要在内存上工作，因此工作速度更快）
使用excel函数总是会减慢该过程，相反，我们将所有索引值存储在omzet工作表的行和标题上，因此，当您指向工作表上C列中的值时，结果将不会计算什么。

在这里：arrSource(DictMatches(arrData(i, 3), DictHeaders(1, j)))我们给出了行位置和列位置。

DictMatches(arrData(i, 3)将带您回到在字典中找到匹配项的行。 DictHeaders(1, j)将带您返回在字典中找到该标题的列。

注意：要使字典正常工作，您需要在引用中选中Microsoft Scripting Runtime库。字典也Case Sensitive如此Hello <> hello。

使例程更有效率？

1 个答案: