4楼
amulee |
不知道对不对，似乎有些繁琐了。
- Sub MyMerge()
- Dim Rng As Range
- Dim i&, arrYS, arrTemp, strJG$, strTemp, strTemp2$
- Dim MyType%, strFG$ '类型和分隔符
- Dim k&, blnStart As Boolean
- Do While MyType <> 1 And MyType <> 2
- MyType = Application.InputBox("1：合并单元格" & vbCrLf & "2：取消合并", "选择类型", 1, , , , , 1)
- Loop
- Do
- strFG = Application.InputBox("请输入分隔符", "分隔符", "-", , , , , 2)
- If InStr(1, strFG, Chr(9), vbTextCompare) = 0 And InStr(1, strFG, Chr(28), vbTextCompare) = 0 _
- And InStr(1, strFG, Chr(10), vbTextCompare) = 0 Then
- Exit Do
- End If
- MsgBox "输入了非法字符，请重新输入。"
- Loop
- '若没有输入，则列之间加入一个看不见摸不着的Chr(9)作为分隔符
- strFG = IIf(Len(strFG) = 0, Chr(9), strFG)
-
- If MyType = 1 Then '合并
- '遍历所有选择的区域
- For Each Rng In Selection.Areas
- '定义一个数组记录
- arrYS = Rng
- ReDim arrTemp(1 To UBound(arrYS, 1))
- '开头那个
- For i = 1 To UBound(arrTemp)
- strJG = ""
- '标志位blnStart表示是否找到了有数据的单元格
- blnStart = False
- For j = 1 To UBound(arrYS, 2)
- If Len(arrYS(i, j)) > 0 Then
- If blnStart Then
- '若已经找到，则表示不是第一个有数据的单元格，前面假山分隔符
- strJG = strJG & strFG & arrYS(i, j)
- Else
- '若标志位为否，则表示是第一个有数据的单元格，前面不需要分隔符
- strJG = strJG & arrYS(i, j)
- blnStart = True
- End If
- Else
- '加入一个看不见的Chr(28)作为空单元格的分隔符
- strJG = strJG & Chr(28)
- End If
- Next j
- arrTemp(i) = strJG
- Next i
- '行之间加入一个换行符
- strJG = Join(arrTemp, Chr(10))
- Application.DisplayAlerts = False
- '合并单元格并设定格式
- With Rng
- .Merge
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- .Item(1) = strJG
- End With
- Application.DisplayAlerts = True
- Next
- Else '拆分
- '遍历所有选择的区域
- For Each Rng In Selection.Areas
- '拆分单元格
- strJG = Rng(1)
- Rng.UnMerge
- '先按行拆
- arrTemp = Split(strJG, Chr(10))
- '遍历数组中每一个元素，即每一行，并填写
- j = 1
- k = Rng.Columns.Count
- For Each strTemp In arrTemp
- '替换所有Chr(28)
- strTemp = Replace(strTemp, Chr(28), strFG, 1, -1, vbTextCompare)
- Rng.Cells(j, 1).Resize(1, k) = Split(strTemp, strFG)
- j = j + 1
- Next
- Next
- End If
- End Sub
|
