[已解决]请教vba排序

武林长风

点击按钮，按各科的及格率（优秀率）将各校由高到低排序。

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2015-7-24 19:11

哦，没注意看到是2个表，改下就好了。

1. 
   
2. Sub 排序()
   
3. Dim arr, i&, Sht As Worksheet
   
4. For Each Sht In Sheets
   
5.     Sht.Activate
   
6.         For i = 1 To Cells(2, "iv").End(xlToLeft).Column Step 2
   
7.             arr = Range(Cells(3, i), Cells(Rows.Count, i + 1).End(3))
   
8.             BubbleSort2 arr
   
9.             Range(Cells(3, i), Cells(Rows.Count, i + 1).End(3)) = arr
   
10.         Next
    
11. Next
    
12. End Sub
    
13. Sub BubbleSort2(ByRef arr)
    
14.   Dim i&, j&, vSwap1, vSwap2
    
15.   For i = UBound(arr) To 2 Step -1
    
16.     For j = 1 To i - 1
    
17.       If arr(j, 2) < arr(j + 1, 2) Then
    
18.         vSwap1 = arr(j, 1)
    
19.         vSwap2 = arr(j, 2)
    
20.         arr(j, 1) = arr(j + 1, 1)
    
21.         arr(j, 2) = arr(j + 1, 2)
    
22.         arr(j + 1, 1) = vSwap1
    
23.         arr(j + 1, 2) = vSwap2
    
24.       End If
    
25.     Next
    
26.   Next
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

gufengaoyue

1. Sub XX()
   
2. For i = 1 To Cells(2, "iv").End(xlToLeft).Column Step 2
   
3.     ActiveSheet.Sort.SortFields.Clear
   
4.     Range(Cells(2, i), Cells(Rows.Count, i + 1).End(3)).Select
   
5.     Range("A1").AutoFilter Field:=1
   
6.     Range("A1").AutoFilter
   
7.     Selection.AutoFilter
   
8.     ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Cells(2, i + 1), SortOn:=xlSortOnValues, Order:=xlDescending
   
9.     ActiveSheet.AutoFilter.Sort.Apply
   
10. Next
    
11. Cells.AutoFilter
    
12. End Sub
    

复制代码

gufengaoyue

好吧。

1. Sub XX()
   
2. dim i&
   
3. For i = 1 To Cells(2, "iv").End(xlToLeft).Column Step 2
   
4.     ActiveSheet.Sort.SortFields.Clear
   
5.     Range(Cells(2, i), Cells(Rows.Count, i + 1).End(3)).Select
   
6.     Range("A1").AutoFilter Field:=1
   
7.     Range("A1").AutoFilter
   
8.     Selection.AutoFilter
   
9.     ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Cells(2, i + 1), SortOn:=xlSortOnValues, Order:=xlDescending
   
10.     ActiveSheet.AutoFilter.Sort.Apply
    
11. Next
    
12. Cells.AutoFilter
    
13. End Sub
    

复制代码

武林长风

gufengaoyue 发表于 2015-7-24 18:49
好吧。

ActiveSheet.Sort.SortFields.Clear

gufengaoyue

武林长风 发表于 2015-7-24 18:51
ActiveSheet.Sort.SortFields.Clear

把这句删了。你用的2003版的？
我没有2003版的可以测。

武林长风

gufengaoyue 发表于 2015-7-24 18:59
把这句删了。你用的2003版的？
我没有2003版的可以测。

删后这句出错了：

gufengaoyue

哦，没注意看到是2个表，改下就好了。

1. 
   
2. Sub 排序()
   
3. Dim arr, i&, Sht As Worksheet
   
4. For Each Sht In Sheets
   
5.     Sht.Activate
   
6.         For i = 1 To Cells(2, "iv").End(xlToLeft).Column Step 2
   
7.             arr = Range(Cells(3, i), Cells(Rows.Count, i + 1).End(3))
   
8.             BubbleSort2 arr
   
9.             Range(Cells(3, i), Cells(Rows.Count, i + 1).End(3)) = arr
   
10.         Next
    
11. Next
    
12. End Sub
    
13. Sub BubbleSort2(ByRef arr)
    
14.   Dim i&, j&, vSwap1, vSwap2
    
15.   For i = UBound(arr) To 2 Step -1
    
16.     For j = 1 To i - 1
    
17.       If arr(j, 2) < arr(j + 1, 2) Then
    
18.         vSwap1 = arr(j, 1)
    
19.         vSwap2 = arr(j, 2)
    
20.         arr(j, 1) = arr(j + 1, 1)
    
21.         arr(j, 2) = arr(j + 1, 2)
    
22.         arr(j + 1, 1) = vSwap1
    
23.         arr(j + 1, 2) = vSwap2
    
24.       End If
    
25.     Next
    
26.   Next
    
27. End Sub
    

复制代码

武林长风

gufengaoyue 发表于 2015-7-24 19:11
那用这个吧

要一个按钮同时完成2个工作表。

gufengaoyue

7楼已改了…来自: iPhone客户端