VBA改成公式两个数在同一行的排序

laoau138

VBA改成公式两个数在同一行的排序

today0427

三种方法排序，以第三种工作表自带的排序功能最为简单，这个显示在工作表2中，第二就是冒泡排序，显示在工作表1的U列，第一种取行号排序我写的复杂了，显示在工作表1的Q列，真希望多些人答题目，不管是你还是我，都能广开思路。

1. Sub todaypx3() '工作表排序
   
2.     Dim arr
   
3.     arr = Sheets("Sheet1").Range("i13:k" & Sheets("Sheet1").[k65536].End(3).Row)
   
4.         With Sheets("Sheet2")
   
5.             .[c1] = "次数"
   
6.             .[a2].Resize(UBound(arr), 3) = arr
   
7.             .Range("a:c").Sort .[c2], 2, , , , , , 1
   
8.         End With
   
9. End Sub

复制代码

1. Sub todaypx2() '冒泡排序
   
2.     Dim arr, i&, j&, t1%, t2%, t3%
   
3.     arr = Sheets("Sheet1").Range("i13:k" & Sheets("Sheet1").[k65536].End(3).Row)
   
4.     For i = 1 To UBound(arr) - 1
   
5.         For j = i + 1 To UBound(arr)
   
6.             If arr(i, 3) < arr(j, 3) Then
   
7.                 t1 = arr(j, 1): t2 = arr(j, 2): t3 = arr(j, 3)
   
8.                 arr(j, 1) = arr(i, 1): arr(j, 2) = arr(i, 2): arr(j, 3) = arr(i, 3)
   
9.                 arr(i, 1) = t1: arr(i, 2) = t2: arr(i, 3) = t3:
   
10.             End If
    
11.         Next
    
12.     Next
    
13.     Sheets("Sheet1").[u13].Resize(UBound(arr), 3).Clear
    
14.     Sheets("Sheet1").[u13].Resize(UBound(arr), 3) = arr
    
15. End Sub

复制代码

1. Sub todaypx1() '取行号排序
   
2.     Dim arr, ar(), brr(), i&, m%, hh, n&, ro&
   
3.     arr = Sheets("Sheet1").Range("i13:k" & Sheets("Sheet1").[k65536].End(3).Row)
   
4.     ReDim ar(0 To UBound(arr))
   
5.    
   
6.     m = Application.WorksheetFunction.Max(Application.Index(arr, , 3))
   
7.     For i = 1 To UBound(arr)
   
8.         ar(arr(i, 3)) = ar(arr(i, 3)) & i & ","
   
9.     Next
   
10.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
11.     For ro = m To 0 Step -1
    
12.         If InStr(ar(ro), ",") Then
    
13.             hh = Split(Left(ar(ro), Len(ar(ro)) - 1), ",")
    
14.         Else: n = n + 1
    
15.               brr(n, 1) = arr(ar(ro), 1): brr(n, 2) = arr(ar(ro), 2): brr(n, 3) = ro
    
16.               GoTo 100
    
17.         End If
    
18.         
    
19.         For i = 0 To UBound(hh)
    
20.             n = n + 1
    
21.             brr(n, 1) = arr(hh(i), 1): brr(n, 2) = arr(hh(i), 2): brr(n, 3) = ro
    
22.         Next
    
23. 100
    
24.    Next
    
25.    Sheets("Sheet1").[q13].Resize(n + 100, 3).Clear
    
26.    Sheets("Sheet1").[q13].Resize(n, 3) = brr
    
27. End Sub
    

复制代码

laoau138

today0427 发表于 2016-10-3 23:20
三种方法排序，以第三种工作表自带的排序功能最为简单，这个显示在工作表2中，第二就是冒泡排序，显示在工 ...

论坛最近比较冷清

lytznh

我在论坛中学到很多东西，希望论坛越办越好