Excel VBA求助：跨工作表匹配单元格值并同步内部颜色

原代码核心问题 #

• 未处理Find方法找不到匹配值的场景，直接调用.Activate会触发运行时错误
• 依赖Select/Activate操作单元格，易因工作表切换、焦点变化导致逻辑混乱
• 变量未声明，存在拼写错误风险
• 直接用地址字符串OA.Select语法错误，需通过Range(OA)引用单元格
• DisplayFormat.Interior.Color仅读取含条件格式的显示色，若要读取单元格本身的填充色，应使用Interior.Color

修正后的单单元格处理代码 #

适用于Sheet1中选中单个单元格的场景：

Option Explicit

Sub FindAndColor_Single()
    Dim sourceCell As Range
    Dim targetSheet As Worksheet
    Dim foundCell As Range
    Dim targetColor As Long
    
    ' 定位Sheet1中选中的源单元格
    Set sourceCell = Sheet1.ActiveCell
    If sourceCell.Value = "" Then Exit Sub ' 空值直接退出
    
    ' 直接引用Sheet2，避免切换工作表操作
    Set targetSheet = Sheet2
    
    ' 在Sheet2第2行精准查找匹配值
    Set foundCell = targetSheet.Rows(2).Find( _
        What:=sourceCell.Value, _
        LookIn:=xlValues, ' 匹配单元格显示值，若需匹配公式结果可改为xlFormulas
        LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
    
    ' 找到匹配项才设置颜色，否则弹窗提示
    If Not foundCell Is Nothing Then
        targetColor = foundCell.Interior.Color
        sourceCell.Interior.Color = targetColor
    Else
        MsgBox "Sheet2第2行未找到匹配值：" & sourceCell.Value
    End If
End Sub

批量处理F列指定行的代码 #

适用于Sheet1中F列第8+11n行（F8、F19、F30...）的批量处理：

Option Explicit

Sub FindAndColor_Batch()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceCell As Range
    Dim foundCell As Range
    Dim targetColor As Long
    Dim currentRow As Long
    
    Set sourceSheet = Sheet1
    Set targetSheet = Sheet2
    
    ' 从F8开始，每次步进11行，直到遇到空行停止
    currentRow = 8
    Do While sourceSheet.Cells(currentRow, "F").Value <> ""
        Set sourceCell = sourceSheet.Cells(currentRow, "F")
        
        ' 执行查找逻辑
        Set foundCell = targetSheet.Rows(2).Find( _
            What:=sourceCell.Value, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        
        ' 设置颜色或提示未找到
        If Not foundCell Is Nothing Then
            targetColor = foundCell.Interior.Color
            sourceCell.Interior.Color = targetColor
        Else
            MsgBox "Sheet2第2行未找到匹配值：" & sourceCell.Value & "（位于F" & currentRow & "）"
        End If
        
        currentRow = currentRow + 11
    Loop
End Sub

关键改进说明 #

• 添加Option Explicit强制变量声明，避免拼写错误
• 取消所有Select/Activate操作，直接通过对象引用单元格和工作表，大幅提升代码稳定性
• 增加Find结果的非空判断，避免未找到匹配值时的错误
• 可根据需求切换LookIn参数，适配值匹配或公式结果匹配场景

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