VBA - 调整大型数据集

Question

我目前有50k +行的两个文件。 它们都包含订单代码。在一个文件中可能是Right（“AQ column”，7），另一个文件将在C列中。 我想匹配订单代码，并比较这些值是否相同。另外，在第二个文件中，应该在另一列中检查是否存在与“SETTLED”匹配的字符串，因为该文件中存在重复的订单代码。

我已经尝试了几种方法，我会在下面贴上一个效率不高的贴子，以便我正在尝试修复以确保清晰。 revnW和Wpay是2个不同的工作簿

DesLRow = revnW.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 
SrcLRow = wPay.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 

For i = 2 to DesLrow 
for j = 3 to srcLrow 
    If right(revnW.Sheets(1).Cells(i,43).text, 7) = wPay.Sheets(1).Cells(j,3).text And_ 
Instr(wPay.Sheets(1).Cells(j,5).text, "SETTLED") And value <> value 2 (pseudo code) Then 


Do stuff (get transaction number, and some other things) 
     exit for 
     next j 
Next i 

我知道这个代码是没有效率的，我试图列加载到一个数组，但然后我只能比较一列，而不是值等。

任何帮助将不胜感激。

Answer 1

未经测试，但应该给你一个起点：

Sub Tester() 

    Dim desLRow As Long, srcLRow As Long 
    Dim dictDest As Object, dictSrc As Object 

    With revnW.Sheets(1) 
     Set dictDest = RowMap(.Range(.Cells(2, 43), .Cells(.Rows.Count, 43).End(xlUp)), 7) 
    End With 
    With wPay.Sheets(1) 
     Set dictSrc = RowMap(.Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp))) 
    End With 

    For Each k In dictDest.keys 
     If dictSrc.exists(k) Then 

      'do the rest of your checks here.... 

      Debug.Print "Match between Dest " & dictDest(k).Address & " and " & _ 
         dictSrc(k).Address 
     End If 
    Next k 

End Sub 

这里的“映射”功能：

'Get a "map" of row keys to the 
' rows where they are located (just maps the first cell in each row) 
' "rng" is the range to be mapped 
' "numright" - pass a number if you just want a part of the value to be mapped 
Function RowMap(rng As Range, Optional numRight As Long = 0) 
    Dim rv, nr As Long, nc As Long, r As Long, c As Long 
    Dim k, data 

    Set rv = CreateObject("scripting.dictionary") 

    data = rng.Value 
    For r = 1 To UBound(data, 1) 
     k = data(r, 1) 
     If numRight > 0 Then k = Right(k, numRight) 
     If rv.exists(k) Then 
      Set rv(k) = Application.Union(rv(k), rng.Columns(1).Cells(r)) 
     Else 
      rv.Add k, rng.Columns(1).Cells(r) 
     End If 
    Next r 
    Set RowMap = rv 
End Function 

Answer 2

我会用一些SQL处理数据。 这里是加入在第三个两页的例子：

Sub QueryExample() 

    Const SQL_JOIN_SHEETS = _ 
    "SELECT * " & _ 
    "FROM [Sheet1$] a INNER JOIN [Sheet2$] b " & _ 
    "ON a.ID = b.ID " 

    SqlExec source:=ThisWorkbook, sql:=SQL_JOIN_SHEETS, target:=[Sheet3] 

End Sub 

'' 
' Executes a query on a workbook. 
' @source {Workbook} Workbook loaded by the SQL engine 
' @target {Worksheet} Worksheet to display the result 
' @sql {String} SQL query 
'' 
Sub SqlExec(source As workbook, sql As String, target As Worksheet) 
    Dim rs As Object, conn$ 
    Set rs = CreateObject("ADODB.recordset") 
    conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ 
    source.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes"";" 

    ' execute the query 
    rs.Open sql, conn 

    ' copy the headers to the target sheet 
    target.Cells.Clear 
    For i = 1 To rs.Fields.Count 
    target.Cells(1, i).Value = rs.Fields(i - 1).Name 
    Next 

    ' copy the values to the target sheet 
    target.Cells(2, 1).CopyFromRecordset rs 

    ' dispose 
    rs.Close 
End Sub