如何使用VBA将Excel中含关键词sold的行从一个工作表移动到另一个

问题修复说明 #

• 原代码存在4个核心问题：
  1. 遍历范围是Q-V整列，包含大量无数据的空单元格，遍历效率极低
  2. 匹配规则用Like "Sold"是完全精确匹配，且区分大小写，无法命中包含sold关键词的内容
  3. 一行中如果多个单元格包含sold会重复复制同一行
  4. 冗余的Done判断逻辑无实际作用，还可能引发死循环

修正后可用代码 #

Option Compare Text '放在模块最顶部，作用是忽略大小写匹配，不需要可以删掉
Sub IntiveResponse()
' 筛选Q-V列包含sold的行复制到Invited表
    Dim srcSht As Worksheet, tarSht As Worksheet
    Dim lastRow As Long, i As Long, tarRow As Long
    Dim hasSold As Boolean
    
    ' 定义源表和目标表，可按需修改表名
    Set srcSht = ThisWorkbook.Worksheets("162545-response-export")
    Set tarSht = ThisWorkbook.Worksheets("Invited")
    
    ' 获取源表最后一行行号
    lastRow = srcSht.UsedRange.Rows.Count
    ' 计算目标表下一个空行的行号
    tarRow = tarSht.Cells(tarSht.Rows.Count, "A").End(xlUp).Row + 1
    ' 如果目标表是空表，从第一行开始粘贴
    If tarRow = 2 And Application.WorksheetFunction.CountA(tarSht.UsedRange) = 0 Then tarRow = 1
    
    Application.ScreenUpdating = False
    ' 逐行遍历源表
    For i = 1 To lastRow
        hasSold = False
        ' 检查当前行Q到V列是否有包含sold的单元格
        For Each cell In srcSht.Range("Q" & i & ":V" & i)
            If CStr(cell.Value) Like "*sold*" Then
                hasSold = True
                Exit For ' 只要找到一个就跳出，避免重复判断
            End If
        Next
        ' 满足条件就复制整行
        If hasSold Then
            srcSht.Rows(i).Copy Destination:=tarSht.Rows(tarRow)
            tarRow = tarRow + 1
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "操作完成，共复制" & tarRow - IIf(tarRow = 1, 1, 2) & "行数据"
End Sub

使用说明 #

• 如果需要完全精确匹配sold才复制，把代码里的"*sold*"改成"sold"即可
• 如果需要区分大小写匹配，删掉模块最顶部的Option Compare Text即可

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