VBA查找A列重复值 复制同组首行H列数据到其余重复行

需求说明 #

• 场景：针对A列存在重复值的行组，例如A1、A2、A3单元格值完全相同
• 目标：将该组第一行（即上例中H1）的内容，自动填充到同组其余行的H列（即上例中H2、H3）
• 现有进度：已完成A列重复值查找、高亮、按重复值筛选、A列升序排序功能，缺少H列自动填充逻辑，原有代码如下：

Sub Doubles()
'
' Doubles Macro
' Les Doubles
'
' Touche de raccourci du clavier: Ctrl+e
'
    Range("A1:I128").Select
    ActiveWindow.SmallScroll Down:=-123
    Selection.AutoFilter
    Range("A:A,H:H").Select
    Range("H1").Activate
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    ActiveSheet.Range("$A$1:$I$128").AutoFilter Field:=1, Criteria1:=RGB(255, _
        199, 206), Operator:=xlFilterCellColor
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A128"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

实现方案 #

原有代码已经完成重复值筛选、排序，同值重复项已经连续排列，直接在排序完成后追加遍历填充逻辑即可，不需要额外引入字典等复杂匹配逻辑。
修改后的完整代码：

Sub Doubles()
'
' Doubles Macro
' Les Doubles
'
' Touche de raccourci du clavier: Ctrl+e
'
    Range("A1:I128").Select
    ActiveWindow.SmallScroll Down:=-123
    Selection.AutoFilter
    Range("A:A,H:H").Select
    Range("H1").Activate
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    ActiveSheet.Range("$A$1:$I$128").AutoFilter Field:=1, Criteria1:=RGB(255, _
        199, 206), Operator:=xlFilterCellColor
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A128"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' 新增：H列重复组首值填充逻辑
    Dim lastRow As Long
    Dim i As Long
    ' 处理范围与原有代码保持一致，数据行数变化时修改此处即可
    lastRow = 128
    ' 从第2行开始遍历，第1行为每组第一个值，无需填充
    For i = 2 To lastRow
        ' 跳过筛选隐藏的非重复值行
        If Not Rows(i).Hidden Then
            ' 当前行A列值与上一行A列值一致时，用上一行H列值填充
            If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
                Cells(i, "H").Value = Cells(i - 1, "H").Value
            End If
        End If
    Next i
End Sub

注意事项 #

• 代码默认处理1-128行数据，和原有代码的范围匹配，如果实际数据行数有变动，修改lastRow = 128中的行号为实际数据最后一行即可
• 填充逻辑仅对筛选后显示的重复值行生效，不会修改非重复值行的H列内容
• 因为已经提前对A列做了升序排序，同值项连续排列，遍历填充的运行效率很高，即使数据量上千行也可以秒级完成

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