[没有的知识]Excel批量向下合并相同单元格(VBA宏)

Sub MergeSameCellsInSelectedColumns()    ' 关闭警告和屏幕刷新以提升速度    Application.DisplayAlerts = False    Application.ScreenUpdating = False    Dim rng As Range    Dim col As Range    Dim i As Long    Dim startRow As Long    Dim endRow As Long    Dim lastRowInCol As Long    Dim currentVal As Variant    ' 获取用户选中的区域    Set rng = Selection    If rng Is Nothing Then        MsgBox "请先选中需要合并的列区域（例如 A:D）", vbExclamation        Exit Sub    End If    ' 遍历选中区域中的每一列（不一定是整列，只遍历选中的部分）    For Each col In rng.Columns        ' 获取该列在选中范围内的实际使用行数（从选中区域的第一行到最后一行）        startRow = rng.Rows(1).Row        endRow = rng.Rows(rng.Rows.Count).Row        ' 如果选中的是整个列，自动定位到该列最后非空行        If endRow > startRow And Application.CountA(col) > 0 Then            lastRowInCol = col.Cells(col.Cells.Count).End(xlUp).Row            If lastRowInCol < endRow Then endRow = lastRowInCol        End If        ' 从下往上扫描，合并相邻相同内容的单元格        i = endRow        Do While i > startRow            currentVal = col.Cells(i, 1).Value            If currentVal = col.Cells(i - 1, 1).Value Then                ' 找到起始行                Dim j As Long                j = i - 1                Do While j > startRow And col.Cells(j, 1).Value = currentVal                    j = j - 1                Loop                j = j + 1   ' 相同的起始行                ' 合并从 j 到 i 的单元格                If j < i Then                    Range(col.Cells(j, 1), col.Cells(i, 1)).Merge                    ' 合并后内容保留在第一个单元格（j行），不影响其他列                End If                i = j - 1            Else                i = i - 1            End If        Loop    Next col    ' 恢复设置    Application.DisplayAlerts = True    Application.ScreenUpdating = True    MsgBox "合并完成！"End Sub