作者：绿色风
分类：
时间：2022-08-17
浏览：137
楼主
kevinchengcw |
Q: 如何用vba代码将单元格中的内容拆分成一行一条并不影响合并单元格区域的效果？
A: 代码如下：（因数据不太规范，故用正则实现拆分）
- Sub test()
- Dim N&, I&, T&, RegEx As Object, mMatch, Str$
- On Error GoTo Skip '遇到出错情况跳至行号skip数
- Application.ScreenUpdating = False '因涉及单元格操作，帮关闭刷新，提高速度
- Set RegEx = CreateObject("vbscript.regexp") '创建正则项目
- With RegEx
- .Global = True '设定全程有效
- .MultiLine = True '设定多行有效
- .Pattern = "[A-Z/]+[ ]*[\d.]+-\d+" '设定匹配规则
- End With
- [a1].CurrentRegion.UnMerge '解除数据区的全部单元格合并
- N = 2 '设定起始行号
- Do While Cells(N, 5) <> "" '循环数据区对应列的各个单元格
- Str = Cells(N, 5).Value '将当前单元格的值赋值给字符串
- If RegEx.Execute(Str).Count > 1 Then '判断正则提取的项数是否达到2个以上，达到则执行下述语句
- Rows(N + 1 & ":" & N + RegEx.Execute(Str).Count - 1).Insert '在当前单元格的下一行开始插入比项数少1的行数（这样当前行加新插入行数就等于总项目数了）
- For Each mMatch In RegEx.Execute(Str) '循环向下写入各个提取子项值
- Cells(N, 5) = mMatch.Value
- N = N + 1 '下移一行
- Next mMatch
- N = N - 1 '因执行完后会超出当前范围，故n值减1
- End If
- N = N + 1 '下移一行
- Loop
- For I = 1 To 4 循环前面需合并区域各列
- T = Cells(Rows.Count, 5).End(3).Row '取得已拆分好的数据区最下行行标
- For N = Cells(Rows.Count, 5).End(3).Row To 2 Step -1 '向上循环
- If Cells(N, I) <> "" Then '根据合并单元格拆分规律，遇有数据时重新合并
- Range(Cells(N, I), Cells(T, I)).Merge
- T = N - 1
- End If
- Next N
- Next I
- [a1].CurrentRegion.Borders.LineStyle = 1 '设置数据区域单元格线
- Skip:
- Application.ScreenUpdating = True '打开屏幕刷新
- Set RegEx = Nothing '清空正则项目
- End Sub
|
2楼
开心E点 |
谢谢分享，学习 |
3楼
bobowuji8858 |
有一行少了一个单引号（第25行，“25.For I = 1 To 4 '循环前面需合并区域各列”）不然会出现语法错误
|
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一