如何使用Excel VBA合并相同值单元格，匹配A列合并范围同步合并后续列

Sub Merge_Similar_Cells()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim WorkRng As Range
    Dim col As Integer
    
    Set ws = ActiveSheet
    
    ws.AutoFilter.ShowAllData
    ws.AutoFilter.Sort.SortFields.Clear
    
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
     
    ws.AutoFilter.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.AutoFilter.Sort.Apply
                                                                                      
    Set WorkRng = ws.Range("A2:A" & LastRow)

CheckAgain:
    For Each cell In WorkRng
        If cell.Value = cell.Offset(1, 0).Value And Not IsEmpty(cell) Then
            ' 合并A列对应范围
            Range(cell, cell.Offset(1, 0)).Merge
            cell.VerticalAlignment = xlCenter
            ' 新增：同步合并B到L列对应范围
            For col = 2 To 12
                Range(ws.Cells(cell.Row, col), ws.Cells(cell.Offset(1, 0).Row, col)).Merge
                ws.Cells(cell.Row, col).VerticalAlignment = xlCenter
            Next col
            GoTo CheckAgain
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

合并单元格会导致排序、筛选、批量编辑等操作异常，该方案仅通过内容清理+格式设置实现和合并单元格完全一致的视觉效果，不会影响表格的正常功能：

Sub Visual_Merge_Without_Real_Merge()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
    Dim LastRow As Long, startRow As Long, i As Long
    Dim ws As Worksheet
    Dim col As Integer
    
    Set ws = ActiveSheet
    
    ws.AutoFilter.ShowAllData
    ws.AutoFilter.Sort.SortFields.Clear
    
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
     
    ws.AutoFilter.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.AutoFilter.Sort.Apply
    
    startRow = 2
    ' 遍历A列分组
    For i = 2 To LastRow
        If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Or IsEmpty(ws.Cells(i + 1, 1)) Then
            ' 处理当前组B-L列
            For col = 2 To 12
                ' 清空组内除第一行外的所有内容
                ws.Range(ws.Cells(startRow + 1, col), ws.Cells(i, col)).ClearContents
                ' 设置整组垂直居中，视觉上和合并效果一致
                ws.Range(ws.Cells(startRow, col), ws.Cells(i, col)).VerticalAlignment = xlCenter
            Next col
            startRow = i + 1
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

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