VBA多行合并

–

VBA多行合并

需求

• 选中一列若干行，根据输入的行数，实现指定行数合并成一个单元格，并将指定行数中的第一个非空行作为合并单元格的值

方案

1. 选择一列或者多列
2. 输入一个数字，代表指定的行数合并成一个单元格
3. 设置格式：居中、加边框、自动换行

代码块

Sub MergeNumber()
    On Error GoTo a ' 保证下一句点“取消”时不会出错
    Set rng = Application.InputBox(prompt:="请选择需要合并的连续区域？", Title:="输入框", Default:=Selection.Address, Type:=8) '选择单元格区域
a:
    If TypeName(rng) <> "Range" Then ' 判断输入单元格区域时是否点击了取消
        Exit Sub
    End If
    add1 = rng.Address
    arr1 = Split(Join(Split(add1, ":"), ""), "$")
    rows1 = CInt(arr1(4)) - CInt(arr1(2)) + 1
    n = Application.InputBox(prompt:="您选中了" & CStr(rows1) & "行；" & Chr(13) & "您想将几行合并为一个单元格？", Title:="输入框", Type:=1)
    If n = "False" Then
        Exit Sub
    End If
  
    flg = rows1 Mod n
    If flg <> 0 Then
        MsgBox "您选中的区域不是您行数的整数倍！"
        Exit Sub
    End If
    Application.DisplayAlerts = False '关闭警告提示“合并区域内有多个值，仅保留第一个值”
    For i = arr1(2) To arr1(4) Step n
        Range(arr1(1) & CStr(i) & ":" & arr1(3) & CStr(i + n - 1)).Merge
    Next
    rng.Borders.LineStyle = True  '加边框
    rng.HorizontalAlignment = xlHAlignCenter  ' 水平居中
    rng.VerticalAlignment = xlVAlignCenter  ' 垂直居中
    rng.WrapText = True '行内换行
    Application.DisplayAlerts = True ' 开启警告提示（恢复默认设置）
  
End Sub