- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-7-9
  
|
3#
發表於 2015-8-16 22:25
| 只看該作者
回復 2# lcctno
你的數據用一般排序就可以做到了啊！不懂為什麼要寫成程式？- Option Base 1
- Public Sub Ex()
- Set d = CreateObject("scripting.dictionary")
- aa = Cells(Rows.Count, 1).End(xlUp).Row
- bb = Cells(Rows.Count, 2).End(xlUp).Row
- Dim ar1()
- If aa < 2 Or bb < 2 Then Exit Sub
- If aa > bb Then
- arr = Range("A3:B" & aa)
- Else
- arr = Range("A3:B" & bb)
- End If
- For i = 1 To UBound(arr) - 1
- For j = i + 1 To UBound(arr)
- If arr(i, 2) > arr(j, 2) Then
- r1 = arr(i, 1)
- r2 = arr(i, 2)
- arr(i, 1) = arr(j, 1)
- arr(i, 2) = arr(j, 2)
- arr(j, 1) = r1
- arr(j, 2) = r2
-
- End If
- Next
- Next
- For i = 1 To UBound(arr)
- If arr(i, 1) <> "" And arr(i, 2) <> "" Then
- n = n + 1
- ReDim Preserve ar1(1 To 2, n)
- ar1(1, n) = arr(i, 1)
- ar1(2, n) = arr(i, 2)
- End If
- Next
- [e3].Resize(UBound(ar1, 2), 2) = Application.Transpose(ar1)
- End Sub
|
|
