将D列的合并格式同步到A列

山海风云轩

求助大佬：
功能需求，在一个配方表中：
1、检查D列格式，如果cell(i,4)是合并单元格，那么检查cell(i,1)是否是同样的合并格式，如果cell(i,4)与cell(i,1)格式不
同，则显色标记出来——已经基本实现（附件有代码），暂未考虑cell(i,4)合并3行而cell(i,1)合并2行的情况，能完善这个最好，感谢！
2、当cell(i,4)和cell(i,1)单元格格式不同时，将cell(i,4)的格式同步到cell(i,1)，这个属于目前的第一需求!!!


详情请见附件

小凡、、、

这样吧---------

山海风云轩

小凡、、、 发表于 2024-9-11 17:40
这样吧---------

感谢大佬，就是需要这种效果

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.11
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     r = Cells(Rows.Count, 1).End(3).Row
   
5.     For i = 2 To r
   
6.         Set Rng = Cells(i, 4)
   
7.         Set rng1 = Cells(i, 1)
   
8.         m = Rng.MergeArea.Count
   
9.         n = rng1.MergeArea.Count
   
10.         If m <> n Then
    
11.             Cells(i, 1).Resize(m).Merge
    
12.         End If
    
13.         i = i + m - 1
    
14.     Next
    
15.     Application.ScreenUpdating = True
    
16.     MsgBox "OK！"
    
17. End Sub
    
18. 
    

复制代码

Qs18

1. Sub qs()
   
2. Dim rng As Range, rng2 As Range
   
3. Application.DisplayAlerts = False
   
4. With Sheet1
   
5.     rw = .Cells(Rows.Count, "d").End(xlUp).Row
   
6.     For i = 3 To rw
   
7.     Set rng = .Range("d" & i)
   
8.     Set rng2 = .Range("a" & i)
   
9.     mct = rng.MergeArea.Count
   
10.     mct2 = rng2.MergeArea.Count
    
11.     If mct <> mct2 Then
    
12.         .Range("a" & i).Resize(mct).Merge
    
13.         rng.Interior.Color = vbRed
    
14.         rng2.Interior.Color = vbRed
    
15.     End If
    
16.     i = i + mct - 1
    
17.     Next
    
18. End With
    
19. Application.DisplayAlerts = True
    
20. Set rng = Nothing: Set rng2 = Nothing
    
21. End Sub

复制代码

Qs18

试试。。。。。。。。。。

Qs18

试试。。。。。。。