关于合并单元格的排序，请求帮助，谢谢。

马小呆

  数据量比较大，电脑比较老旧。希望可以快速排序，谢谢。

liulang0808

建议楼主先上传一个模拟附件吧，便于大家了解情况

ykcbf1100

如果不破坏原数据的话，感觉不太好下手啊

马小呆

liulang0808 发表于 2023-2-28 15:02
建议楼主先上传一个模拟附件吧，便于大家了解情况

这样模拟可以吗？

马小呆

ykcbf1100 发表于 2023-2-28 15:23
如果不破坏原数据的话，感觉不太好下手啊

大师都这么说，看来是希望渺茫了啊

ykcbf1100

马小呆 发表于 2023-2-28 15:30
这样模拟可以吗？

没有合并单元格应该是没问题的。

马小呆

ykcbf1100 发表于 2023-2-28 16:09
没有合并单元格应该是没问题的。

如果先排序再合并单元格呢？后面的数据不会乱吧?

shenzhenyang

1. Sub 解除合并单元格()
   
2. Dim b%, rng As Range
   
3.   last = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
   
4. '     For Each rng In Selection
   
5.      For Each rng In Range("D5:F" & last)
   
6.          b = rng.MergeArea.Count
   
7.          rng.UnMerge
   
8.          rng.Resize(b) = rng
   
9.      Next
   
10.      Call test6
    
11. End Sub
    
12. 
    
13. 
    
14. 
    
15. Sub test6()
    
16. 
    
17.     last = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
    
18. '    Range("A5:F" & last).UnMerge
    
19.     With ActiveSheet.Sort
    
20.         With .SortFields
    
21.             .Clear
    
22.             .Add2 Key:=Range("E5:E" & last), Order:=xlDescending
    
23.             .Add2 Key:=Range("F5:F" & last), Order:=xlDescending
    
24.             .Add2 Key:=Range("P5:P" & last), Order:=xlDescending
    
25.         End With
    
26.         .SetRange Range("E5:U" & last)
    
27.         .Apply
    
28.     End With
    
29. Call 合并相同单元格1
    
30. Call 合并相同单元格2
    
31. Call 合并相同单元格3
    
32. End Sub
    
33. 
    
34. Sub 合并相同单元格1()
    
35. Dim merng As Range
    
36. Dim r
    
37. r = "D"
    
38. Application.DisplayAlerts = False
    
39. Set merng = Range(r & "5")
    
40. For i = 5 To [D65536].End(xlUp).Row
    
41. 
    
42.     If Range(r & i) = Range(r & i - 1) Then
    
43.         Set merng = merng.Resize(merng.Count + 1, 1)
    
44.     Else
    
45.         merng.Merge
    
46.         Set merng = Range(r & i)
    
47.     End If
    
48. Next
    
49. merng.Merge
    
50. Application.DisplayAlerts = True
    
51. End Sub
    
52. 
    
53. 
    
54. Sub 合并相同单元格2()
    
55. Dim merng As Range
    
56. Dim r
    
57. r = "E"
    
58. Application.DisplayAlerts = False
    
59. Set merng = Range(r & "5")
    
60. For i = 5 To [D65536].End(xlUp).Row + 1
    
61. 
    
62.     If Range(r & i) = Range(r & i - 1) Then
    
63.         Set merng = merng.Resize(merng.Count + 1, 1)
    
64.     Else
    
65.         merng.Merge
    
66.         Set merng = Range(r & i)
    
67.     End If
    
68. Next
    
69. merng.Merge
    
70. Application.DisplayAlerts = True
    
71. End Sub
    
72. 
    
73. Sub 合并相同单元格3()
    
74. Dim merng As Range
    
75. Dim r
    
76. r = "F"
    
77. Application.DisplayAlerts = False
    
78. Set merng = Range(r & "5")
    
79. For i = 5 To [D65536].End(xlUp).Row + 1
    
80. 
    
81.     If Range(r & i) = Range(r & i - 1) Then
    
82.         Set merng = merng.Resize(merng.Count + 1, 1)
    
83.     Else
    
84.         merng.Merge
    
85.         Set merng = Range(r & i)
    
86.     End If
    
87. Next
    
88. merng.Merge
    
89. Application.DisplayAlerts = True
    
90. End Sub

复制代码

代码抄论坛老师，我不懂，只能组装式，但不知道对不对，希望老师能合并代码
想学多列同时循环合并，怎么弄。

shenzhenyang

马小呆

shenzhenyang 发表于 2023-2-28 20:00

这样也可以啊。
请问一下怎么做的？