基于双条件将行复制至其他工作表的VBA实现需求

需求说明 #

每日从数据库导出含案例的Excel文件，月底案例量可达400条以上，需筛选非本部门的待核查案例。拟通过VBA实现以下功能：

• 点击Sheet1（"Overview"）上的ActiveX按钮"UpdateData"
• 将Sheet2（"Input Filtered"）中满足以下两个条件的行复制至"Overview"表：
  1. 案例编号（Sheet2的B列）不以"52/"开头；
  2. 该案例编号未出现在Sheet3（"Checked Cases"）的A列中。

现有代码（仅完成列复制，需补充筛选逻辑） #

Private Sub UpdateData_Click()

    Dim wsSource As Worksheet, wsTarget As Worksheet, WsHSource As Worksheet

    With ThisWorkbook
        Set wsTarget = .Sheets("Overview")
        Set wsSource = .Sheets("Input")
        Set WsHSource = .Sheets("Input Filtered")
     End With

    wsTarget.Range("B7:I500").ClearContents
    WsHSource.Range("A2:H494").ClearContents
    wsSource.Range("A2:C494").Copy
    WsHSource.Range("A2:C494").PasteSpecial xlPasteValues
    wsSource.Range("E2:I494").Copy
    WsHSource.Range("D2:H494").PasteSpecial xlPasteValues

End Sub

补充筛选逻辑后的完整代码 #

Private Sub UpdateData_Click()

    Dim wsSource As Worksheet, wsTarget As Worksheet, wsFiltered As Worksheet, wsChecked As Worksheet
    Dim lastRowFiltered As Long, lastRowTarget As Long, i As Long
    Dim caseId As String
    Dim found As Range

    ' 定义工作表对象
    With ThisWorkbook
        Set wsTarget = .Sheets("Overview")
        Set wsSource = .Sheets("Input")
        Set wsFiltered = .Sheets("Input Filtered")
        Set wsChecked = .Sheets("Checked Cases")
    End With

    ' 清除原有数据
    wsTarget.Range("B7:I500").ClearContents
    wsFiltered.Range("A2:H494").ClearContents

    ' 从Input表复制数据到Input Filtered表
    wsSource.Range("A2:C494").Copy
    wsFiltered.Range("A2:C494").PasteSpecial xlPasteValues
    wsSource.Range("E2:I494").Copy
    wsFiltered.Range("D2:H494").PasteSpecial xlPasteValues
    Application.CutCopyMode = False ' 取消复制状态

    ' 获取Input Filtered表的最后一行数据
    lastRowFiltered = wsFiltered.Cells(wsFiltered.Rows.Count, "B").End(xlUp).Row
    ' 初始化Overview表的起始行
    lastRowTarget = 7

    ' 遍历Input Filtered表的每一行，筛选符合条件的数据
    For i = 2 To lastRowFiltered
        caseId = wsFiltered.Cells(i, "B").Value
        ' 条件1：案例编号不以"52/"开头；条件2：编号未出现在Checked Cases的A列
        If Left(caseId, 3) <> "52/" Then
            Set found = wsChecked.Range("A:A").Find(What:=caseId, LookIn:=xlValues, LookAt:=xlWhole)
            If found Is Nothing Then
                ' 复制符合条件的行到Overview表
                wsFiltered.Rows(i).Copy
                wsTarget.Cells(lastRowTarget, "B").PasteSpecial xlPasteValues
                lastRowTarget = lastRowTarget + 1
            End If
        End If
    Next i

    Application.CutCopyMode = False

End Sub

代码说明 #

• 新增wsChecked工作表对象，对应"Checked Cases"表
• 用Left(caseId, 3)判断案例编号是否以"52/"开头
• 通过Range.Find方法检查案例编号是否已存在于"Checked Cases"的A列
• 遍历Input Filtered表的有效数据行，将符合双条件的行复制到Overview表的B7起始位置
• 加入Application.CutCopyMode = False取消复制状态，避免Excel残留复制提示

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