- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-27
|
8#
發表於 2017-2-24 14:20
| 只看該作者
- Sub test_1()
- Dim xD As Object, Arr, Brr, V, N&, U%, i&, j%, k%, Km%
- Set xD = CreateObject("Scripting.Dictionary")
- s = Array(1, 5, 10, 15, 20, 30, 40, 50, 100, 200, 400, 600, 800, 1000, 2000, 3000, 60000)
- Arr = Range("A8:C" & [A65536].End(3).Row)
- ReDim Brr(1 To UBound(Arr), 1 To UBound(s) * 4 + 1)
- del
- For i = 1 To UBound(Arr)
- V = Arr(i, 1): U = xD(V)
- If U = 0 Then N = N + 1: U = N: xD(V) = N: Brr(U, 1) = V
- For j = 2 To 3
- Km = 0
- For k = 0 To UBound(s)
- If s(k) * 1000 > Arr(i, j) Then Km = (k - 1) * 4: Exit For
- Next k
- If Km >= 0 Then
- Brr(U, Km + j * 2 - 2) = Brr(U, Km + j * 2 - 2) + Arr(i, j)
- Brr(U, Km + j * 2 - 1) = Brr(U, Km + j * 2 - 1) + 1
- End If
- Next j
- Next i
- With [D8].Resize(N, UBound(s) * 4 + 1)
- .Value = Brr
- .Sort Key1:=.Item(1), Order1:=xlDescending, Header:=xlNo
- End With
- End Sub
|
|
發表於 2017-2-20 18:50
| 
