用於比較兩個工作表中的兩列並復制公共數據的 VBA 代碼

Question

我在一張工作表（工作表 1）中有 100 萬條記錄，在另一張工作表（工作表 2）中有 16k 條記錄。根據工作表 2 中每一行的前 20 個字符，它應該檢查工作表 1 中的每一行並復制該行在任何工作表的單獨列中。我已經記錄了第一條記錄的示例宏，但我想提到這里所有功能的單元格范圍，而不是在整個列上處理它的數據。

Sub test1()
'
' test1 Macro
' test1
'

'
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "XYZ00026245931CA9B05500045Y80Invalid value in code ID"
    Sheets("Sheet1").Select
    Range("D1").Select
    Cells.Find(What:="XYZ00026245931CA9B05", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Range("C1").Select
    ActiveCell.FormulaR1C1 = _
        "XYZ00026245931CA9B05005000000000000004500Y8                     "
    Range("D1").Select
    ActiveSheet.Paste
End Sub

Answer 1

我假設您熟悉 vlookup 功能，如果熟悉，那么您可以使用部分 vlookup 來完成您的任務。

假設如下：

1. 查找值：工作表 2，A 列
2. 查找表：工作表 1，A 到 B 列
3. 返回值：查找表的第 2 列

根據您的需要調整此公式：（當前設置為用於工作表 2，第一行）

=VLOOKUP(LEFT($A1,20)&"*",Sheet1!$A:$B,2,FALSE)

Answer 2

這對我來說是一個有用的學習工具，所以我繼續創建了 VBA 來回答您的原始問題。 正如 Jitendra Singh 所說，這是蠻力和資源，消耗。 在我的機器上，僅執行 1000 行就需要大約 20 秒。 因此，對於您的 16,000 個條目，它很容易花費 5 分鍾以上的時間。 考慮到這一點，我設計了幾個安全網：

• 用戶輸入以確定您將一次查看多少行。 我建議小口服用。
• 一個每 10 秒暫停一次的計時器，以確保您想繼續前進（在If tmElapsed > 10 Then行調整時間）
• 用戶選擇超過 1000 行時的警告（在If rngCompare.Cells.Count > 1000 Then行調整警告的行數）

也就是說，這就是我想出的：

Sub Compare20char()
' This Sub will look in the cells specified by the user.
' It will compare the first 20 characters of those cells to the first 20 characters in
' the cells in Sheet1, beginning at A2 and continuing to the end of the data in Column A.
' For each match, it will copy the entire cell in Sheet1, Column A to an array.
' After completing its review, it will paste that array to the first empty cell in Column A of Sheet3.

    Dim cell, rngSource, rngCompare, rngTarget As Range
    Dim arrData() As Variant
    Dim i, LastRow As Integer
    Dim tmRef, tmElapsed, tmTotal As Double

    Set rngSource = Sheets("Sheet1").Range("A2:A" & WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A")))
    i = 0

'Get A Cell Address From The User to Get Number Format From
  On Error Resume Next
    Set rngCompare = Application.InputBox( _
      Title:="Select Reference Range", _
      Prompt:="Select the cells in Sheet2 for which you would like to retrieve the data in Sheet 1.", _
      Type:=8)
  On Error GoTo 0

'Test to ensure User Did not cancel and rngCompare is not excessively large
    If rngCompare Is Nothing Then Exit Sub
    If rngCompare.Cells.Count > 1000 Then
        If MsgBox("You have selected " & rngCompare.Cells.Count & " cells. This may take extended time to run. Continue?", _
            vbQuestion + vbYesNo + vbDefaultButton2, "Warning") = vbNo Then GoTo EscapeHatch
    End If

' Begin timer
    tmRef = Timer

' Begin loop to review each cell and fill array
    For Each cell In rngCompare
        If WorksheetFunction.CountIf(rngSource, Left(cell, 20) & "*") = 1 Then
            i = i + 1
            ReDim Preserve arrData(1 To i)
            arrData(i) = cell.Value
            tmElapsed = Timer - tmRef
            If tmElapsed > 10 Then
                If MsgBox("Since the last break:" & vbNewLine & vbNewLine & "Run time: " & Round(tmElapsed, 2) & " seconds" & vbNewLine _
                    & "Records reviewed: " & i & vbNewLine & vbNewLine & "Continue?" & vbNewLine & vbNewLine & _
                    "(If you select ""No"", the spreadsheet will be unchanged.)", vbQuestion + vbYesNo + vbDefaultButton2, _
                    "Extended Run Time") = vbNo Then GoTo EscapeHatch
                tmTotal = tmTotal + tmElapsed
                tmRef = Timer
            End If
        End If
    Next

' Paste array to end of Column A in Sheet3
    With Sheets("Sheet3")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    End With
    Set rngTarget = Sheets("Sheet3").Range("A" & LastRow & ":A" & LastRow + i - 1)
    rngTarget = WorksheetFunction.Transpose(arrData)

' Report results
    tmTotal = tmTotal + tmElapsed
    Debug.Print tmTotal
    MsgBox "Run time: " & Round(tmTotal, 2) & " seconds" & vbNewLine & "Records reviewed: " & i & _
        vbNewLine & vbNewLine & "Records pasted to Sheet3."

Exit Sub

EscapeHatch:
    tmTotal = tmTotal + tmElapsed
    MsgBox "Run time: " & Round(tmTotal, 2) & " seconds" & vbNewLine & "Records reviewed: " & i & _
        vbNewLine & vbNewLine & "No changes made."

End Sub

祝你好運。