Question

我在一张纸上有1百万条记录（第1页），在另一张纸上有16k条记录（第2页）。基于第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完成任务。

假设以下内容：

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

根据您的需要调整此公式：（当前设置为在工作表2，第一行使用）

= VLOOKUP（LEFT（$ A1,20）＆“ *”，Sheet1！$ A：$ B，2，FALSE）

Answer 2

这对我来说是个有用的学习工具，因此我继续创建了VBA，它可以回答您的原始问题。正如Jitendra Singh所提到的，这是消耗性的蛮力和资源。在我的机器上，大约花了20秒才能完成1000行。因此，对于您的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

祝你好运。

VBA代码比较两个工作表中的两列并复制公共数据

2 个答案: