Sub FillAndMergeCells()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim startCell As Range
    Dim lastRow As Long
    Dim currentValue As Variant
    
    'Set the active worksheet
    Set ws = ActiveSheet
    
    '获取最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    '设置要处理的范围
    Set rng = ws.Range("A1:A" & lastRow)
    
    '先填充空白单元格
    For Each cell In rng
        If IsEmpty(cell) Then
            cell.Value = cell.End(xlUp).Value
        End If
    Next cell
    
    '开始合并相同值的单元格
    Set startCell = rng.Cells(1)
    currentValue = startCell.Value
    
    Application.ScreenUpdating = False
    
    For Each cell In rng
        If cell.Row > 1 Then
            If cell.Value <> currentValue Then
                '如果值不同，合并之前的区域
                If startCell.Row <> cell.Row - 1 Then
                    Range(startCell, ws.Cells(cell.Row - 1, startCell.Column)).Merge
                End If
                Set startCell = cell
                currentValue = cell.Value
            ElseIf cell.Row = lastRow Then
                '如果是最后一行且值相同，合并到最后
                Range(startCell, cell).Merge
            End If
        End If
    Next cell
    
    '设置合并后的格式
    With rng
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "合并完成！", vbInformation
End Sub

Sub AddMacroButton()
    '添加一个按钮来运行宏
    Dim btn As Button
    Set btn = ActiveSheet.Buttons.Add(100, 10, 120, 30)
    With btn
        .OnAction = "FillAndMergeCells"
        .Caption = "合并相同值"
    End With
End Sub