vba - 是否可以将其转换为数组/字典以使其更快

Question

我使用这个 vba 代码来查找一个包含 100000+ 行和列的文件。是否可以将此代码重写为数组或使用脚本字典？

   Sub vlookuptest()
   Dim i As Long
   On Error Resume Next
   For i = 2 To 1048576
   Sheets("Prices").Cells(i, 6) = Application.WorksheetFunction.VLookup((Worksheets("Prices").Cells(i, 4) & Worksheets("Prices").Cells(i, 3)), Worksheets("Raw Delta").Range("A:O"), 14)
   Next i
   End Sub

这是我的试用代码。这个问题是它不能完美地搜索。

  Option Explicit
  
  Sub DRT_GetValues()
  Dim supplierNumber As String
  supplierNumber = ThisWorkbook.Sheets("Main").Range("D5").Value
  Const COL_ARTNUM As Long = 1
  Const COL_ARTDESC As Long = 2
  Const COL_PRICECITY As Long = 9
  Const COL_PRICECOUNTRY As Long = 10
  Const COL_CURRENCY As Long = 11
  Const COL_NETPRICE As Long = 14
  
  Dim d As Variant, u As Long, r As Long, k, action, w As Long, x As Long, y As Long
  Dim dict As Object
  Dim dOut(), rOut As Long, i As Long
  Dim newRow As Boolean
  
  Set dict = CreateObject("scripting.dictionary")
  
  d = Sheets("Raw Delta").Range("A2").CurrentRegion.Offset(2, 0).Value
  u = UBound(d, 1) - 1
  
  i = 1
  ReDim dOut(1 To u, 1 To 14) 'to hold the output data
  
  
  'loop over the input data
  For r = 1 To u
  
  
  k = d(r, COL_ARTNUM) & d(r, COL_PRICECOUNTRY) & d(r, COL_PRICECITY) & "-" & supplierNumber
  
  If Not dict.exists(k) Then
  dOut(i, 6) = d(r, COL_NETPRICE)
  dict.Add k, i
  i = i + 1
  End If
  rOut = dict(k)
  
  Dim wow As String
  wow = Sheets("Prices").Cells(i, 4) & Sheets("Prices").Cells(i, 3)
  
  If wow = k Then
  
  dOut(rOut, 1) = d(r, COL_NETPRICE)
  
  End If
  
  Next r
     
     
  
  Sheets("Prices").Range("f2").Resize(u, 14).Value = dOut
  
  End Sub

Answer 1

这将使用“原始数据”工作表的 A 列作为 构建脚本字典对象。 key N 列中的价格 (...?) 为 项目 .

在“价格”工作表上，它从 C 和 D 列中获取数据。为了从字典中查找价格，它连接这些值并查找匹配的键。

最后，它将找到的值返回到“价格”整体的 F 列。

Sub vlookup_replacement()
    Dim v As Long, vRDA As Variant, vRDN As Variant, vPDC As Variant
    Dim dRDAN As Object

    'Debug.Print Timer
    Set dRDAN = CreateObject("Scripting.Dictionary")

    With Worksheets("Raw Data")
        vRDA = Intersect(.Columns("A:A"), .UsedRange).Value2
        vRDN = Intersect(.Columns("N:N"), .UsedRange).Value2
        For v = LBound(vRDA, 1) To UBound(vRDA, 1)
            If Not dRDAN.exists(vRDA(v, 1)) Then _
                dRDAN.Add Key:=vRDA(v, 1), Item:=vRDN(v, 1)
        Next v
    End With

    'Debug.Print dRDAN.Count & ":" & UBound(vRDN, 1)

    With Worksheets("Prices")
        With .Cells(2, 3).Resize(.Cells(Rows.Count, 3).End(xlUp).Row - 1, 4)
            .Columns(4).ClearContents
            vPDC = Intersect(.Columns("A:B"), .Cells).Value2
            For v = LBound(vPDC, 1) To UBound(vPDC, 1)
                vPDC(v, 2) = vPDC(v, 2) & vPDC(v, 1)
                vPDC(v, 1) = dRDAN.Item(vPDC(v, 2))
            Next v
            .Cells(1, 4).Resize(UBound(vPDC, 1), 1) = vPDC
        End With
    End With

    'Debug.Print Timer

    dRDAN.RemoveAll: Set dRDAN = Nothing

End Sub

在大内存块内工作的很大一部分改进是避免循环通过单个工作表单元格。了解数据的性质、关键列中的唯一值以及找到匹配项的机会有助于通过避免不必要的错误控制来设计流程。

虽然这肯定会比你的 VLOOKUP functions 快，您可以为其添加一些功能。