Excel 比较Sheet1列A值与Sheet2列B值，如果匹配，则Sheet2.列C=Sheet1.列A与Sheet2.列D=True

我想比较Sheet1列A值和Sheet2列B值，如果匹配，我想将Sheet1列A值放入Sheet2列C中。 和D列应填充“True” 因此，我编写了以下代码：

Sub val() 
Dim sheet1_last_rec_cnt As Long 
Dim sheet2_last_rec_cnt As Long 
Dim sheet1_col1_val As String 
Dim cnt1 As Long 
Dim cnt2 As Long 
sheet1_last_rec_cnt = Sheet1.UsedRange.Rows.Count 
sheet2_last_rec_cnt = Sheet2.UsedRange.Rows.Count 
For cnt1 = 2 To sheet1_last_rec_cnt 
sheet1_col1_val = Sheet1.Range("A" & cnt1).Value 
For cnt2 = 2 To sheet2_last_rec_cnt 
If sheet1_col1_val = Sheet2.Range("B" & cnt2).Value Then 
Sheet2.Range("C" & cnt2).Value = sheet1_col1_val 
Sheet2.Range("D" & cnt2).Value = "True" 
Exit For 
End If 
Next 
Next 
End Sub 

问题是我在两张纸上都有一百万条记录。 如果我使用上面的代码，那么For循环将运行（一百万*一百万）次。所以excel像任何东西一样挂着。

---

有人能帮我优化代码吗？

对于100万条记录，我不确定Excel是否是存储这些数据的最佳位置。如果您的代码设计用于整理数据，以便您可以将其导出到数据库，那么很好。。。如果没有，那么，我担心前面会有汹涌的大海

下面的代码将加快速度，因为它只在每个列中循环一次，并填充一个唯一值的集合，因此每次只需检查该值，而不必检查整个列。如果你对你的行进行排序，那么它可能会变得更快，但我会把这个留给你

Public Sub RunMe()
    Dim uniques As Collection
    Dim sourceValues As Variant
    Dim targetValues As Variant
    Dim sourceItem As String
    Dim targetItem As String
    Dim sourceCount As Long
    Dim targetCount As Long
    Dim matches As Boolean
    Dim output() As Variant

    ' Acquire the values to be compared.
    With ThisWorkbook.Worksheets("Sheet1")
        sourceValues = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Value2
    End With
    With ThisWorkbook.Worksheets("Sheet2")
        targetValues = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
    End With

    'Resize the output array to size of target values array.
    ReDim output(1 To UBound(targetValues, 1), 1 To 2)

    sourceCount = 1
    Set uniques = New Collection

    'Iterate through the target values to find a match in the source values
    For targetCount = 1 To UBound(targetValues, 1)

        targetItem = CStr(targetValues(targetCount, 1))
        matches = Contains(uniques, targetItem)

        If Not matches Then

            'Continue down the source sheet to check the values.
            Do While sourceCount <= UBound(sourceValues, 1)

                sourceItem = CStr(sourceValues(sourceCount, 1))
                sourceCount = sourceCount + 1

                'Add any new values to the collection.
                If Not Contains(uniques, sourceItem) Then uniques.Add True, sourceItem

                'Check for a match and leave the loop if we found one.
                If sourceItem = targetItem Then
                    matches = True
                    Exit Do
                End If

            Loop

        End If

        'Update the output array if there's a match.
        If matches Then
            output(targetCount, 1) = targetItem
            output(targetCount, 2) = True
        End If

    Next

    'Write output array to the target sheet.
    ThisWorkbook.Worksheets("Sheet2").Range("C2").Resize(UBound(targetValues, 1), 2).value = output

End Sub
Private Function Contains(col As Collection, key As String) As Boolean
    'Function to test if the key already exists.
    Contains = False
    On Error Resume Next
    Contains = col(key)
    On Error GoTo 0
End Function

公共子运行库（）
Dim uniques作为集合
Dim SourceValue作为变量
变暗目标值作为变量
将sourceItem设置为字符串
作为字符串的Dim targetItem
将sourceCount设置为长
变暗目标计数为长
作为布尔值的Dim匹配
Dim output（）作为变量
'获取要比较的值。
使用此工作簿。工作表（“表1”）
sourceValues=.Range（.Cells（2，“A”），.Cells（.Rows.Count，“A”）.End（xlUp））.Value2
以
使用此工作簿。工作表（“表2”）
targetValues=.Range（.Cells（2，“B”），.Cells（.Rows.Count，“B”）.End（xlUp））.Value2
以
'将输出数组的大小调整为目标值数组的大小。
重拨输出（1到UBound（目标值，1），1到2）
sourceCount=1
Set uniques=新集合
'遍历目标值以在源值中找到匹配项
对于targetCount=1到UBound（targetValues，1）
targetItem=CStr（targetValue（targetCount，1））
matches=包含（uniques、targetItem）
如果不匹配，则
'继续向下查看源工作表以检查值。
sourceCount中是否有重复的值，或者每个值都是唯一的？