如何用VBA依据单元格内容选中行？共享工作簿宏条件转数问题

我给你分几种常见场景来写代码，你可以根据自己的需求调整：

场景1：选中单个符合条件的行 #

比如要找A列第一个内容为"Target"的行，直接选中整行：

Sub SelectSingleRowByCellValue()
    Dim targetCell As Range
    ' 在Sheet1的A列精确查找值为"Target"的第一个单元格
    Set targetCell = ThisWorkbook.Sheets("Sheet1").Columns("A").Find(What:="Target", LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not targetCell Is Nothing Then
        ' 选中该单元格所在的整行
        targetCell.EntireRow.Select
    Else
        MsgBox "没找到匹配内容的行哦！"
    End If
End Sub

要是需要模糊匹配（比如单元格包含"Target"就行），把LookAt:=xlWhole改成LookAt:=xlPart就行。

场景2：选中所有符合条件的行 #

如果要把所有A列内容为"Target"的行都选中，用Union合并多个行更高效：

Sub SelectAllRowsByCellValue()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRange As Range
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取A列最后一行的行号
    
    For i = 1 To lastRow
        If ws.Cells(i, "A").Value = "Target" Then
            If targetRange Is Nothing Then
                Set targetRange = ws.Rows(i)
            Else
                ' 把符合条件的行合并到同一个Range对象里
                Set targetRange = Union(targetRange, ws.Rows(i))
            End If
        End If
    Next i
    
    If Not targetRange Is Nothing Then
        targetRange.Select
    Else
        MsgBox "没找到匹配内容的行哦！"
    End If
End Sub

小提示：别在循环里频繁选行，先把所有符合条件的行存到Range里，最后一次性选中，速度会快很多。

你的宏逻辑本身没问题，但在共享工作簿环境下有几个坑要注意，同时可以优化代码让它更稳定：

1. 处理共享工作簿的冲突问题 #

共享工作簿多人编辑时容易出冲突，建议在宏开头加锁定操作，结束后解锁：

Sub TransferYesRows()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    
    Set wsSource = ThisWorkbook.Sheets("源表")
    Set wsTarget = ThisWorkbook.Sheets("目标表")
    
    ' 锁定工作簿避免多人编辑冲突（如果共享设置允许的话）
    On Error Resume Next
    ThisWorkbook.LockServerFile
    On Error GoTo 0
    
    ' 先取消之前的筛选，避免影响新筛选
    If wsSource.AutoFilterMode Then wsSource.AutoFilterMode = False
    
    ' 筛选A列为"yes"的行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    wsSource.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:="yes"
    
    ' 复制筛选后的可见行（跳过表头）到目标表的最后一行下方
    wsSource.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
        Destination:=wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)
    
    ' 清除源表中已转移的行内容
    wsSource.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.ClearContents
    
    ' 取消筛选，恢复正常视图
    wsSource.AutoFilterMode = False
    
    ' 界面整理：自动调整列宽
    wsTarget.Columns.AutoFit
    wsSource.Columns.AutoFit
    
    ' 解锁工作簿
    On Error Resume Next
    ThisWorkbook.UnlockServerFile
    On Error GoTo 0
    
    MsgBox "数据转移完成啦！"
End Sub

2. 避免条件格式丢失的小技巧 #

• 复制时用Copy默认会带格式，但共享工作簿可能有特殊限制，你可以试试用PasteSpecial明确粘贴所有内容：

  wsSource.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
  wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
  Application.CutCopyMode = False
  

• 另外，把条件格式改成基于公式的规则，用相对引用（比如=$A1="yes"），这样即使数据转移到新表，条件格式也能自动适配目标行。

3. 更高效的替代方案：直接移动行 #

如果不需要保留源表的空行，直接剪切粘贴比复制后清除更高效：

wsSource.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Cut _
    Destination:=wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)

不过注意：共享工作簿中剪切操作可能触发冲突，建议先在测试环境试试。

内容的提问来源于stack exchange，提问作者Jared.T