VBA实现将首个匹配行复制至另一工作表的代码咨询

以下是实现需求的VBA代码——仅复制A列中首次出现指定匹配值的整行到目标工作表，后续重复匹配行将被跳过：

Sub CopyFirstMatchingRow()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim matchValue As String
    Dim processedValues As Object
    
    ' 设置源工作表和目标工作表名称，根据实际情况修改
    Set wsSource = ThisWorkbook.Worksheets("源数据")
    Set wsTarget = ThisWorkbook.Worksheets("目标表")
    ' 设置要匹配的条件值，比如这里是"AAA"，可按需修改
    matchValue = "AAA"
    
    ' 初始化字典，用于记录已处理过的匹配值
    Set processedValues = CreateObject("Scripting.Dictionary")
    
    ' 获取源表最后一行行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源表A列数据
    For i = 1 To lastRow
        ' 检查当前行A列值是否匹配目标值，且未被处理过
        If wsSource.Cells(i, "A").Value = matchValue And Not processedValues.Exists(matchValue) Then
            ' 复制整行到目标表的下一个空行
            wsSource.Rows(i).Copy Destination:=wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)
            ' 将该匹配值标记为已处理，避免后续重复复制
            processedValues.Add matchValue, True
            ' 找到首个匹配行后可直接退出循环，提升效率
            Exit For
        End If
    Next i
    
    ' 释放对象
    Set processedValues = Nothing
    Set wsSource = Nothing
    Set wsTarget = Nothing
    
    MsgBox "首个匹配行已复制完成！"
End Sub

代码说明 #

• 你需要根据实际工作表名称修改wsSource和wsTarget的赋值内容
• matchValue变量可替换为你需要匹配的具体值（比如数值、文本）
• 用Scripting.Dictionary来记录已处理的匹配值，确保仅复制首次出现的行
• 找到首个匹配行后执行Exit For直接终止循环，减少不必要的遍历

如果需要匹配多个不同条件（比如同时匹配"AAA"、"BBB"），可以使用以下代码：

Sub CopyFirstMatchingRowsForMultipleValues()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim matchValues As Variant
    Dim val As Variant
    Dim processedValues As Object
    
    Set wsSource = ThisWorkbook.Worksheets("源数据")
    Set wsTarget = ThisWorkbook.Worksheets("目标表")
    ' 设置多个匹配条件，按需添加或修改
    matchValues = Array("AAA", "BBB", "CCC")
    
    Set processedValues = CreateObject("Scripting.Dictionary")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历每个匹配条件
    For Each val In matchValues
        ' 遍历源表行，寻找该条件的首个匹配行
        For i = 1 To lastRow
            If wsSource.Cells(i, "A").Value = val And Not processedValues.Exists(val) Then
                wsSource.Rows(i).Copy Destination:=wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)
                processedValues.Add val, True
                Exit For ' 找到首个匹配后退出内层循环
            End If
        Next i
    Next val
    
    Set processedValues = Nothing
    Set wsSource = Nothing
    Set wsTarget = Nothing
    
    MsgBox "所有指定条件的首个匹配行已复制完成！"
End Sub

内容的提问来源于stack exchange，提问作者Paul