求一个批量处理相同内容合并的代码

monvzhilei

有没有批量处理课程表中相同内容合并单元格的工具，
因为班级很多，导致类似的课程表也超级多。


我提供原始的表如下：

Z23计算机1.zip (9.42 KB, 下载次数: 43)

2024-1-19 14:57 上传

点击文件名下载附件

我最终需要的效果是：

需要的效果表.zip (9.59 KB, 下载次数: 13)

2024-1-19 15:03 上传

点击文件名下载附件

lizhipei78

lizhipei78

批量合并单元格.rar (17.02 KB, 下载次数: 15)

2024-1-19 15:30 上传

点击文件名下载附件

喂你吃粑粑

1. Sub 合并相同课程()
   
2. Application.DisplayAlerts = False
   
3. Dim i%, j%, irow%, k%
   
4. Dim rng As Range
   
5. irow = Range("a1000").End(xlUp).Row
   
6. 
   
7. For i = 2 To 7
   
8.     k = 0
   
9.     For j = 5 To irow + 1
   
10.         If Cells(j, i) = Cells(j - 1, i) Then
    
11.             k = k + 1
    
12.         End If
    
13.         If Cells(j, i) <> Cells(j - 1, i) And k > 0 Then
    
14.             Set rng = Range(Chr(i + 64) & j - 1 - k & ":" & Chr(i + 64) & j - 1)
    
15.             rng.HorizontalAlignment = xlCenter
    
16.             rng.VerticalAlignment = xlCenter
    
17.             rng.Merge
    
18.             k = 0
    
19.         End If
    
20.         If k > 1 And Cells(j - 1, i) = "" And j = irow + 1 Then
    
21.             Set rng = Range(Chr(i + 64) & j - k & ":" & Chr(i + 64) & j - 1)
    
22.             rng.Merge
    
23.         End If
    
24.     Next j
    
25. Next i
    
26. Application.DisplayAlerts = True
    
27. End Sub

复制代码

monvzhilei

lizhipei78 发表于 2024-1-19 15:30

您好，这个基本满足要求，不过还有一点就是如何能自动调整行高？合并内容以后，有很多是行高太高了。
我添加了这个代码：Selection.Rows(i).AutoFit，不过还是无法真正的自动调整行高。好多内容还是隐藏了。

monvzhilei

喂你吃粑粑 发表于 2024-1-19 18:35

我测试了一下，这个代码也是基本符合要求。就是如何才能真正的自动调整行高？我指的是合并以后，调整行高。

lizhipei78

monvzhilei 发表于 2024-1-20 09:24
您好，这个基本满足要求，不过还有一点就是如何能自动调整行高？合并内容以后，有很多是行高太高了。
我 ...

论坛内有一个帖子是批量调整自动行高的，我不记得了，你自己查找一下。

lizhipei78

供参考，自己整合一下到批量合并代码中，就可以一键完成了

monvzhilei

lizhipei78 发表于 2024-1-20 11:07
供参考，自己整合一下到批量合并代码中，就可以一键完成了

我这个复制过去，结果全部隐藏了。奇怪了。