筛选，合并单元格，排序，有老师指导下么

Crazy_Wu

求助表格中能自动筛选，完后合并单元格，并按时间顺序排序，上传了附件，想通过VBA批量生成如同格式样的，有老师帮忙指导下么，谢谢了

moonlit123

分类和名称是一一对应的？
还是同一个分类A下面有多个名称（1、其他、其他1）？
按照你附件要求，

主要是实现同分类下的 日期排序， 以及 合并单元格就行了。

Crazy_Wu

moonlit123 发表于 2019-9-9 08:49
分类和名称是一一对应的？
还是同一个分类A下面有多个名称（1、其他、其他1）？
按照你附件要求，

谢谢答复，A下面只有1，B下面只有2，只是1个2的数量不定

w609053988

按分类或者名称排序，在for+if判断所有连续的节点，再根据这些节点来合并，因分类和名称是一一对应，任意判断一列即可

moonlit123

排序是默认用宏录制做的 自定义排序
后半段是合并单元格

做得比较粗糙。大部分是录制宏的代码。

1. Sub 排序()
   
2. Application.DisplayAlerts = False
   
3. 
   
4. arr = Sheets(1).Range("A1:C" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Value
   
5. Sheets(1).Range("G1:I" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row) = arr
   
6. 
   
7. Worksheets("Sheet1").Sort.SortFields.Clear
   
8. Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G2:G" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
9. Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I2:I" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
10. With ActiveWorkbook.Worksheets("Sheet1").Sort
    
11.         .SetRange Range("G1:I" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
    
12.         .Header = xlYes
    
13.         .MatchCase = False
    
14.         .Orientation = xlTopToBottom
    
15.         .SortMethod = xlPinYin
    
16.         .Apply
    
17. End With
    
18. 
    
19. arr = Sheets(1).Range("G1:I" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Value
    
20. 
    
21. j = 2
    
22. For i = 3 To UBound(arr)
    
23. If arr(i - 1, 1) <> arr(i, 1) Then
    
24.     Range("G" & i - 1 & ":G" & j).Merge
    
25.     Range("H" & i - 1 & ":H" & j).Merge
    
26.     j = i
    
27. End If
    
28. Next i
    
29.     Range("G" & i - 1 & ":G" & j).Merge
    
30.     Range("H" & i - 1 & ":H" & j).Merge
    
31. 
    
32.     Columns("G:H").Select
    
33.     With Selection
    
34.         .HorizontalAlignment = xlCenter
    
35.         .VerticalAlignment = xlCenter
    
36.     End With
    
37. 
    
38. Application.DisplayAlerts = True
    
39. End Sub
    
40. 
    

复制代码

Crazy_Wu

moonlit123 发表于 2019-9-9 09:32
排序是默认用宏录制做的 自定义排序
后半段是合并单元格

谢谢，达到了目的，再去修改下，实际比这复杂些