[已解决]求助高手：高难VBA字符串二步排序？

zwj8859

最佳答案

月排行榜 / 总排行榜

上清宫主

2018-11-8 10:44

基本思想差不多，都用了辅助列，故原表B、C列不能有内容：
Sub test()
Dim ar1(), ar2()
ar1 = [a2:a8].Value
ReDim ar2(1 To UBound(ar1), 1 To 2)
For i% = 1 To UBound(ar1)
    ar2(i, 1) = Val(Split(ar1(i, 1), "+")(1))
    ar2(i, 2) = Val(Split(ar1(i, 1), "-")(1))
Next
[b2].Resize(i - 1, 2) = ar2
[A2].Resize(i - 1, 3).Sort [c1], xlAscending, [b1], , xlAscending
[b2].Resize(i - 1, 2).Clear
End Sub

跳转到最佳答案楼层

ppp710715

1. Sub 二次排序()
   
2.     Dim rw%
   
3.     rw = [a2].End(4).Row
   
4.         Range("B2").Select
   
5.         ActiveCell.FormulaR1C1 = _
   
6.             "=MID(RC[-1],FIND(""-"",RC[-1])+1,FIND(""Q"",RC[-1])-FIND(""-"",RC[-1])-1)"
   
7.         Range("C2").Select
   
8.         ActiveCell.FormulaR1C1 = _
   
9.             "=MID(RC[-2],FIND(""+"",RC[-2])+1,FIND(""/"",RC[-2])-FIND(""+"",RC[-2])-1)"
   
10.             
    
11.         Range("B2:C2").Select
    
12.         Selection.AutoFill Destination:=Range("B2:C" & rw), Type:=xlFillDefault
    
13.         
    
14.     Range("A2:C" & rw).Select
    
15.     ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B" & rw), _
    
16.         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    
17.         xlSortTextAsNumbers
    
18.     ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C2:C" & rw), _
    
19.         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    
20.         xlSortTextAsNumbers
    
21.         
    
22.     With ActiveWorkbook.Worksheets("Sheet1").Sort
    
23.         .SetRange Range("A2:C" & rw)
    
24.         .Header = xlGuess
    
25.         .MatchCase = False
    
26.         .Orientation = xlTopToBottom
    
27.         .SortMethod = xlPinYin
    
28.         .Apply
    
29.     End With
    
30.    
    
31.     Range("b2:C" & rw).ClearContents
    
32.     [c2].Select
    
33.     MsgBox "排序完成！"
    
34. End Sub
    

复制代码

ppp710715

附件上传不了

zwj8859

谢谢你！程序内容那么多，难度肯定大，贴子公布很久了，没有一点消息，我以为没希望了。不过今天打开，我真的很意外的。再次谢谢高手老师！

上清宫主

基本思想差不多，都用了辅助列，故原表B、C列不能有内容：
Sub test()
Dim ar1(), ar2()
ar1 = [a2:a8].Value
ReDim ar2(1 To UBound(ar1), 1 To 2)
For i% = 1 To UBound(ar1)
    ar2(i, 1) = Val(Split(ar1(i, 1), "+")(1))
    ar2(i, 2) = Val(Split(ar1(i, 1), "-")(1))
Next
[b2].Resize(i - 1, 2) = ar2
[A2].Resize(i - 1, 3).Sort [c1], xlAscending, [b1], , xlAscending
[b2].Resize(i - 1, 2).Clear
End Sub

zwj8859

上清宫主 发表于 2018-11-8 10:44
基本思想差不多，都用了辅助列，故原表B、C列不能有内容：
Sub test()
Dim ar1(), ar2()

用数组简单明了，高手老师谢谢！！！

zwj8859

上清宫主 发表于 2018-11-8 10:44
基本思想差不多，都用了辅助列，故原表B、C列不能有内容：
Sub test()
Dim ar1(), ar2()

ar1 = [a2:a8].Value能否改成“A列的非空单元格”？不知怎么改？再麻烦老师！