按指定内容排序的VBA写法

jacksc

各位老师：详见附件，A-D列数据，首先按“别克”排序，再按“雪佛兰”排序，再按“荣威”排序，再按“名爵”排序，再按“大众”排序，请教VBA代码如何写？谢谢！
test.rar (6.86 KB, 下载次数: 13)

2017-11-24 10:33 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Application.AddCustomList ListArray:=Array("别克", "雪佛兰", "荣威")
   
3.   With Worksheets("sheet1")
   
4.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.     .Range("a1:d" & r).Sort Key1:=Range("a1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=Application.CustomListCount + 1
   
6.   End With
   
7.   Application.DeleteCustomList ListNum:=Application.CustomListCount
   
8. End Sub
   

复制代码

chxw68

自定义排序。

chxw68

试试SQL排序。

1. Sub test()
   
2.   Dim cnn As New ADODB.Connection
   
3.   Dim rs As New ADODB.Recordset
   
4.   Dim sql As String
   
5.   Dim mybook As String
   
6.   mybook = ThisWorkbook.FullName
   
7.   With cnn
   
8.     If Application.Version = "11.0" Then
   
9.       .Provider = "microsoft.jet.oledb.4.0"
   
10.       .ConnectionString = "extended properties=""excel 8.0;HDR=NO;IMEX=1"";data source=" & mybook
    
11.     Else
    
12.       .Provider = "microsoft.ACE.oledb.12.0"
    
13.       .ConnectionString = "extended properties=""excel 12.0;HDR=NO;IMEX=1"";data source=" & mybook
    
14.     End If
    
15.     .Open
    
16.   End With
    
17.   sql = "select * from [sheet1$a1:d] order by instr('别克雪佛兰荣威',F1) desc"
    
18.   rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
19.   With Worksheets("sheet2")
    
20.     .Cells.Delete
    
21.     For j = 0 To rs.Fields.Count - 1
    
22.       .Cells(1, j + 1) = rs.Fields(j).Name
    
23.     Next
    
24.     .Range("a2").CopyFromRecordset rs
    
25.   End With
    
26. End Sub
    

复制代码

chxw68

一题两解。

jacksc

chxw68 发表于 2017-11-24 10:41

老师：您好！
       现在数据转置为横向，我将 Application.CustomListCount + 1 修改为 xlLeftToRight，结果没有达到想要的效果，请教代码该如何修改？谢谢！

凤翔时代

chxw68 发表于 2017-11-24 10:41
自定义排序。

我可以参考运用到人员类别了，呵呵