比較Sheet1列A值與Sheet2列B如果匹配然後Sheet2.Col C = Sheet1.Col A和Sheet2.Col D = True

Question

我想比較Sheet1列A值與Sheet2列B，如果匹配then我希望把工作表Sheet1列A值在Sheet2中列C. 和列d應與「真」 所以我寫了下面的代碼來填充：

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就像任何東西一樣掛着。 有人可以幫我優化代碼嗎？

Answer 1

對於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