仅对纵向合并单元格拆分填充，横向合并的（包括多行多列）不拆分

aman1516

对连横合纵有点犯晕，偶尔也伸下手： 仅对纵向合并单元格拆分填充，横向合并的（包括多行）不拆分.rar (9.82 KB, 下载次数: 15)

2017-10-14 12:32 上传

点击文件名下载附件

CC例例

1. Sub UnMerge()
   
2.     Dim StrMer$, IntCot&, i&, x%
   
3.     Application.ScreenUpdating = False
   
4.     For i = 3 To [f65536].End(3).Row
   
5.         If Not Cells(i, "f").MergeCells Then
   
6.             For x = 5 To 10
   
7.                 StrMer = Cells(i, x).Value
   
8.                 IntCot = Cells(i, x).MergeArea.Count
   
9.                 Cells(i, x).UnMerge
   
10.                 Range(Cells(i, x), Cells(i + IntCot - 1, x)).Value = StrMer
    
11.             Next
    
12.             i = i + IntCot - 1
    
13.         End If
    
14.     Next
    
15.     Application.ScreenUpdating = True
    
16. End Sub

复制代码

CC例例

附件供参考

aman1516

CC例例 发表于 2017-10-14 14:39
附件供参考

非常谢谢，但就现有的规范数据有点取巧（不好意思，是我的数据未列出各种情况）
请看新附件，或随意设置各种合并单元格测试，上述代码会出错。
若横向合并单元格（包括多行多列）是“参差不齐”的列数行数时，如何识别“横向”还得挠下头......
仅对纵向合并单元格拆分填充，横向合并的（包括多行多列）不拆分(2).rar (20.89 KB, 下载次数: 11)

2017-10-14 18:29 上传

点击文件名下载附件

yaozong

aman1516 发表于 2017-10-14 16:57
非常谢谢，但就现有的规范数据有点取巧（不好意思，是我的数据未列出各种情况）
请看新附件，或随意设置 ...

1. Sub 撤销合并()
   
2. Dim s$, i&, j&, k&, r&
   
3. r = Cells(Rows.Count, 6).End(3).Row
   
4. For j = 5 To 12
   
5.   For i = 1 To r
   
6.     With Cells(i, j)
   
7.       If .MergeCells Then
   
8.         If .MergeArea.Columns.Count = 1 Then
   
9.           s = .Value
   
10.           k = .MergeArea.Count
    
11.           .UnMerge
    
12.           .Resize(k) = s
    
13.           i = i + k - 1
    
14.         End If
    
15.       End If
    
16.     End With
    
17.   Next
    
18. Next
    
19. End Sub
    

复制代码

yaozong

参考附件               

仅对纵向合并单元格拆分填充，横向合并的（包括多行多列）不拆分(2).rar (21.05 KB, 下载次数: 41)

2017-10-14 19:12 上传

点击文件名下载附件

aman1516

yaozong 发表于 2017-10-14 19:12
参考附件

if .MergeArea.Columns.Count=1 then
反之，只对横向单行的拆分就是：
if .MergeArea.Rows.Count=1 then

惭愧，自己基本太不扎实了，谢谢yaozong老师的指教

blackttea1

好程序 ，学习啦！