VBA：一种快速方法，用于比较两个不同工作表中的两列，并从工作表1中相应单元格旁边的第二个工作表中复制值

Question

首先，如果我的英语不太好，我会提前道歉，我会尽力解释我的需要。

因此，基本上，我有一个带有2个工作表的excel文件，名为“ Balance”和“ Balance_MAJ”。

看起来像这样（只是一个小示例）： “ Balance”＆“ Balance_MAJ”

我需要将“ Balance”的 D列与“ Balance_MAJ”的D 列进行比较，以便使用“ Balance_MAJ”列G中的值更新“ Balance”的F 列 。

实际上，这两张纸的D列包含相同的信息，但顺序不同。 因此，我必须进行2次循环来比较这2列，并且每次匹配时，我都会在“ Balance_MAJ”的G列中获得相应的值，并将其放入“ Balance”的F列中的相应单元格中。

那样的事情： 我需要做什么

问题是我的整个数据集包含大量数据（今天大约有12000行，将来可能包含更多行）。 我使用了两种方法，在两种情况下都可以完美工作，但是速度确实很慢（第一种方法大约为1mn50sec，第二种方法为47sec）。

第一种方法（1mn50sec）：

`Sub MAJ_Balance()

Dim i As Long
Dim j As Long
Dim lastRow_Balance As Long
Dim lastRow_BalanceMAJ As Long
Dim stNow As Date

stNow = Now

Application.ScreenUpdating = False

lastRow_Balance = Sheets("Balance").Cells(Rows.Count, "D").End(xlUp).Row
lastRow_BalanceMAJ = Sheets("Balance_MAJ").Cells(Rows.Count, 
"D").End(xlUp).Row

    For i = 5 To lastRow_Balance
      For j = 5 To lastRow_BalanceMAJ 
        If Sheets("Balance").Cells(i, "D").Value = 
           Sheets("Balance_MAJ").Cells(j, "D").Value Then
           Sheets("Balance").Cells(i, "F").Value = 
           Sheets("Balance_MAJ").Cells(j, "G").Value
        End If
      Next j
    Next i

MsgBox (DateDiff("s", stNow, Now))

Application.ScreenUpdating = True

End Sub`

第二种方法（47秒）：

`Sub MAJ_Balance()

Dim i As Long
Dim j As Long
Dim v As Variant
Dim lastRow_Balance As Long
Dim lastRow_BalanceMAJ As Long
Dim stNow As Date

stNow = Now

Application.ScreenUpdating = False

lastRow_Balance = Sheets("Balance").Cells(Rows.Count, "D").End(xlUp).Row
lastRow_BalanceMAJ = Sheets("Balance_MAJ").Cells(Rows.Count, 
"D").End(xlUp).Row

    For i = 5 To lastRow_Balance
      With Sheets("Balance").Cells(i, "D")
      v = .Value
      For j = 5 To lastRow_BalanceMAJ 
        If v = Sheets("Balance_MAJ").Cells(j, "D").Value Then
        Sheets("Balance").Cells(i, "F").Value = 
        Sheets("Balance_MAJ").Cells(j, "G").Value
        End If
      Next j
      End With
    Next i

MsgBox (DateDiff("s", stNow, Now))

Application.ScreenUpdating = True

End Sub`

您对代码优化有任何想法吗？ 最快的方法是什么？

预先感谢您的帮助！

Answer 1

我测试了另外两种方法，一种使用VLOOKUP，另一种使用建议的数组。 我使用了您提供的样本设置，并将数据复制到了两张纸上的第28,676行。 这是这两种方法以及我的速度测试宏的代码：

Sub VLOOKUP_Method()

    Dim wb As Workbook
    Dim wsBal As Worksheet
    Dim wsMAJ As Worksheet

    Set wb = ActiveWorkbook
    Set wsBal = wb.Sheets("Balance")
    Set wsMAJ = wb.Sheets("Balance_MAJ")

    With wsBal.Range("F5", wsBal.Cells(wsBal.Rows.Count, "F").End(xlUp))
        .Formula = "=VLOOKUP(D" & .Row & ",'" & wsMAJ.Name & "'!D:G,4,FALSE)"
        .Value = .Value
    End With

End Sub

Sub ARRAY_Method()

    Dim wb As Workbook
    Dim wsBal As Worksheet
    Dim wsMAJ As Worksheet
    Dim aBalData As Variant
    Dim aMAJData As Variant
    Dim i As Long, j As Long

    Set wb = ActiveWorkbook
    Set wsBal = wb.Sheets("Balance")
    Set wsMAJ = wb.Sheets("Balance_MAJ")

    aBalData = wsBal.Range("B4").CurrentRegion.Value
    aMAJData = wsMAJ.Range("B4").CurrentRegion.Value

    For i = LBound(aBalData, 1) To UBound(aBalData, 1)
        For j = LBound(aMAJData, 1) To UBound(aMAJData, 1)
            If aBalData(i, 3) = aMAJData(j, 3) Then
                aBalData(i, 5) = aMAJData(j, 6)
                Exit For
            End If
        Next j
    Next i

    wsBal.Range("B4").Resize(UBound(aBalData, 1), UBound(aBalData, 2)).Value = aBalData

End Sub

Sub SpeedTests()

    Dim dTimer As Double
    Dim aResults(1 To 100, 1 To 2) As Variant
    Dim i As Long, j As Long

    j = 0
    For i = 1 To UBound(aResults, 1)
        j = j + 1
        dTimer = Timer
        VLOOKUP_Method
        aResults(j, 1) = Timer - dTimer
    Next i

    j = 0
    For i = 1 To UBound(aResults, 1)
        j = j + 1
        dTimer = Timer
        ARRAY_Method
        aResults(j, 2) = Timer - dTimer
    Next i

    Sheets("Speed_Results").Range("A2").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults

End Sub

这是我的系统上的速度测试的结果。 VLOOKUP快了约2.5倍