VBA中如何使用Offset将单元格值移动至上方首个指定颜色单元格

完全可以通过Offset配合向上循环遍历实现需求，针对15万行的大区域范围，建议先关闭屏幕更新提升运行效率，完整实现逻辑如下：

核心逻辑说明 #

• 遍历R列1-150000行区域，匹配填充色为ColorIndex=4（默认调色板绿色）的单元格
• 从匹配到的绿色单元格上一行开始，逐行向上遍历同列单元格，直到找到第一个填充为黄色（默认调色板ColorIndex=6）的单元格
• 增加边界判断，遍历到工作表首行仍未找到黄色单元格时自动跳过，避免运行报错
• 找到目标黄色单元格后，按偏移规则写入对应值即可

完整可运行代码 #

Sub FillValueByColor()
    Dim cell As Range, yellowTarget As Range
    Dim currentRow As Long
    ' 关闭屏幕更新，大幅提升大区域遍历速度
    Application.ScreenUpdating = False
    
    For Each cell In Range("R1:R150000")
        ' 匹配指定填充色的单元格（此处为ColorIndex=4的绿色）
        If cell.Interior.ColorIndex = 4 Then
            Set yellowTarget = Nothing
            ' 从当前行的上一行开始向上逐行检查
            For currentRow = cell.Row - 1 To 1 Step -1
                ' 判断是否为黄色填充，若为自定义RGB色可替换为.Interior.Color = RGB(255,255,0)
                If Cells(currentRow, "R").Interior.ColorIndex = 6 Then
                    Set yellowTarget = Cells(currentRow, "R")
                    Exit For
                End If
            Next currentRow
            
            ' 找到黄色单元格后写入值，Offset(0,2)代表向右偏移2列，可根据实际需求调整偏移量
            If Not yellowTarget Is Nothing Then
                yellowTarget.Offset(0, 2).Value = cell.Value
            End If
        End If
    Next cell
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "处理完成"
End Sub

调整说明 #

• 若你需要直接把值写入黄色单元格本身，不需要向右偏移，把yellowTarget.Offset(0, 2).Value修改为yellowTarget.Value即可
• 如果你使用的是自定义填充色而非默认调色板颜色，建议把ColorIndex判断替换为Color属性判断，例如标准黄色可写为.Interior.Color = RGB(255,255,0)，避免主题色、自定义色导致匹配失效
• 代码默认匹配当前绿色单元格向上遇到的第一个黄色单元格，匹配到后就会停止向上遍历，符合逐行向上查找的需求

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