–
VBA多行合并
需求
- 选中一列若干行,根据输入的行数,实现指定行数合并成一个单元格,并将指定行数中的第一个非空行作为合并单元格的值
方案
- 选择一列或者多列
- 输入一个数字,代表指定的行数合并成一个单元格
- 设置格式:居中、加边框、自动换行
代码块
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