请教：合并相同内容单元格

forestry1992

ykcbf1100 发表于 2024-2-11 08:37
你的代码思路挺好的，但细节上略有瑕疵，不能直接使用，因为附件中是没有Sheets2表的，另外呢，单元格每 ...

ykcbf老师，特别感谢，是我想要的结果，太感谢！
另外，我是菜鸟，只能照搬使用，如何将合并区域限定在b4:e2000这个区域范围内进行合并？

准提部林

這要如何併???

leeson7502

参与一下，sheet1内容复制到“合并”表处理：

forestry1992

leeson7502 发表于 2024-2-11 21:04
参与一下，sheet1内容复制到“合并”表处理：

谢谢，好像不太行

ykcbf1100

forestry1992 发表于 2024-2-11 11:48
ykcbf老师，特别感谢，是我想要的结果，太感谢！
另外，我是菜鸟，只能照搬使用，如何将合并区域限定在b ...

把数据范围改一下就行了。

其实，代码不需要修改，因为是根据实际使用范围来定的，更适合实际情况。

leeson7502

forestry1992 发表于 2024-2-12 08:51
谢谢，好像不太行

如果按照你提供的表格，我测试是没

1. Sub myMerge()
   
2.     '//BY冷水泡茶，微信公众号：VBA编程实战
   
3.     '//案例代码已分享至公众号文章，欢迎关注查看
   
4.     Dim ws As Worksheet
   
5.     Dim lastRow As Integer, lastCol As Integer
   
6.     Dim leftTop As Range, rightDown As Range
   
7.     Dim rngMerge As Range
   
8.     Set ws = ThisWorkbook.Sheets("合并")
   
9.     Application.DisplayAlerts = False
   
10.     With ws
    
11.         lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    
12.         lastCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
    
13.         For j = 2 To lastCol
    
14.             For i = 4 To lastRow
    
15.                 If .Cells(i, j) <> .Cells(i - 1, j) Then
    
16.                     Set leftTop = .Cells(i, j)
    
17.                 End If
    
18.                 If .Cells(i, j) <> .Cells(i + 1, j) Then
    
19.                     If Not .Cells(i, j).MergeCells Then
    
20.                         For k = j To lastCol
    
21.                             If .Cells(i, k) <> .Cells(i, k + 1) Then
    
22.                                 Set rightDown = .Cells(i, k)
    
23.                                 Set rngMerge = .Range(leftTop, rightDown)
    
24.                                 rngMerge.Merge
    
25.                                 Debug.Print rngMerge.Address
    
26.                                 Debug.Print "i=:" & i
    
27.                                 Debug.Print "j=:" & j
    
28.                                 Exit For
    
29.                             End If
    
30.                         Next
    
31.                     End If
    
32.                 End If
    
33.             Next
    
34.         Next
    
35.     End With
    
36.     Application.DisplayAlerts = True
    
37. End Sub
    

复制代码

有问题的，但如果把表头“总计”部分修改为其他内容，确实有点问题，没有跳过已合并的单元格。修改一下：

forestry1992

ykcbf1100 发表于 2024-2-13 14:26
把数据范围改一下就行了。

其实，代码不需要修改，因为是根据实际使用范围来定的，更适合实际情况。

ykcbf1100老师辛苦了，谢谢。还有个小问题，如在e4:h2000区域之外有已被合并单元格，将被拆分。谢谢您。

ykcbf1100

forestry1992 发表于 2024-2-14 09:31
ykcbf1100老师辛苦了，谢谢。还有个小问题，如在e4:h2000区域有已被合并单元格，将一并被拆分。谢谢您。

如果在合并区域已有合并单元格，如果这些合并单元格也要一起参与合并的话，原则上这些已合并单元格要先拆分为普通单元格，并且，值也要还原成原来的样子才行。代码也可以做，但没附件的话，代码不太好写。

forestry1992

leeson7502 发表于 2024-2-13 16:10
如果按照你提供的表格，我测试是没
有问题的，但如果把表头“总计”部分修改为其他内容，确实有点问题， ...

谢谢leeson7502老师，使用中有一个问题：在合并区域之外，如右侧的单元格有相同内容，也将被合并成一个单元格。谢谢。

forestry1992

ykcbf1100 发表于 2024-2-14 09:46
如果在合并区域已有合并单元格，如果这些合并单元格也要一起参与合并的话，原则上这些已合并单元格要先拆 ...

辛苦老师，重新上传表格。