Excel VBA：如何将含CLOCKIFY/DROPBOX的行复制至Web-Vendors工作表

需求说明 #

• 在「Expenses-2022」工作表的「Description」列中，查找包含「CLOCKIFY」或「DROPBOX」的文本
• 复制包含任一上述关键词的整行数据
• 将复制的行粘贴至同一工作簿的「Web-Vendors」工作表中

原有代码（仅支持CLOCKIFY筛选） #

Sub CopyRowsToWebVendorsTab()

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' Define source and target worksheets
    Set sourceSheet = ThisWorkbook.Sheets("2022-Expenses")
    
    ' Check if the target worksheet "CLOCKIFY" exists, create it if not
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets("Web-Vendors")
    On Error GoTo 0
    If targetSheet Is Nothing Then
        Set targetSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetSheet.Name = "Web-Vendors"
    End If
    
    ' Find the last row in the source worksheet
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each row in the source sheet
    For i = 1 To lastRow
        ' Check if the cell in column A of the current row contains "CLOCKIFY"
        If InStr(1, sourceSheet.Cells(i, 1).Value, "CLOCKIFY", vbTextCompare) > 0 Then
            ' Copy the entire row to the target sheet
            sourceSheet.Rows(i).Copy targetSheet.Cells(targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1, 1)
        End If
    Next i
    
    ' Clean up
    Set sourceSheet = Nothing
    Set targetSheet = Nothing

End Sub

修改后的完整代码 #

Sub CopyRowsToWebVendorsTab()

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim descCol As Long ' 存储Description列的列号
    
    ' 定义源工作表（注意：原代码中表名为"2022-Expenses"，若实际是"Expenses-2022"请修改此处）
    Set sourceSheet = ThisWorkbook.Sheets("2022-Expenses")
    
    ' 检查目标工作表是否存在，不存在则新建
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets("Web-Vendors")
    On Error GoTo 0
    If targetSheet Is Nothing Then
        Set targetSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetSheet.Name = "Web-Vendors"
    End If
    
    ' 获取Description列的列号（假设表头在第1行，根据实际表头名称调整）
    descCol = sourceSheet.Rows(1).Find(What:="Description", LookIn:=xlValues, LookAt:=xlWhole).Column
    
    ' 找到源工作表的最后一行
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, descCol).End(xlUp).Row
    
    ' 遍历每一行数据（从第2行开始，跳过表头）
    For i = 2 To lastRow
        ' 检查当前行Description列是否包含CLOCKIFY或DROPBOX（不区分大小写）
        If InStr(1, sourceSheet.Cells(i, descCol).Value, "CLOCKIFY", vbTextCompare) > 0 _
           Or InStr(1, sourceSheet.Cells(i, descCol).Value, "DROPBOX", vbTextCompare) > 0 Then
            ' 复制整行到目标工作表的下一行
            sourceSheet.Rows(i).Copy targetSheet.Cells(targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1, 1)
        End If
    Next i
    
    ' 释放对象
    Set sourceSheet = Nothing
    Set targetSheet = Nothing

End Sub

关键修改点 #

1. 修正列定位逻辑：通过表头查找Description列的列号，避免硬编码列标，适配不同表格结构
2. 新增多关键词判断：用Or连接两个InStr函数，实现同时筛选含「CLOCKIFY」或「DROPBOX」的行
3. 优化遍历范围：从第2行开始遍历，跳过表头行（若表头不在第1行，可修改i的起始值）
4. 修正注释错误：更新原代码中错误的注释内容，确保代码可读性
5. 增强兼容性：通过列号获取最后一行，避免因空行导致的遍历范围不准确

附Excel数据说明 #

表格包含Date、Description、Amount等列，其中Description列存在包含CLOCKIFY、DROPBOX关键词的交易条目。

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