資料整理與統計 - Excel程式區 - 麻辣家族討論版版

[發問] 資料整理與統計

論壇贊助勳章論壇榮譽勳章

3^# 跳轉到 »

發表於 2017-2-22 16:52 | 只看該作者

謝謝kubi大大你熱心幫我這個忙
只是經我測試似乎(將程式碼以按鍵趨動)
除了數據顯示位置有誤外
依編號各級距所合計與筆數似乎與我自己做的函數+手動的數聚有所差距

2^#

發表於 2017-2-22 14:34 | 只看該作者

請測試

Option Base 1
Sub test()
Dim d As Object
Dim arr, brr()
Set d = CreateObject("Scripting.Dictionary")
s = Array(1000, 5000, 10000, 15000, 20000, 30000, 40000, 50000, 100000, 200000, 400000, 600000, 800000, 1000000, 2000000, 3000000)
er = [A65536].End(3).Row
arr = Range("A8:C" & er)
Range("A8:C" & er).Sort key1:=[A8], Order1:=2
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
n = n + 1
d(arr(i, 1)) = n
End If
Next i
ReDim brr(d.Count, UBound(s) * 4)
[D8:D65536].ClearContents
[D8].Resize(d.Count) = Application.Transpose(d.keys)
Range("A8:C" & er) = arr
For i = 1 To UBound(arr)
For j = 2 To 3
If arr(i, j) >= 1000 Then
For a = 1 To UBound(s) - 1
If arr(i, j) >= s(a) And arr(i, j) < s(a + 1) Then
brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 3) = brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 3) + arr(i, j)
brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 2) = brr(d(arr(i, 1)), (a - 1) * 4 + j * 2 - 2) + 1
Exit For
End If
Next a
End If
Next j
Next i
[E8].Resize(UBound(brr), UBound(brr, 2)) = brr
arr = ""
Set d = Nothing
Erase brr
End Sub

複製代碼

靜思自在 : 我們最大的敵人不是別人．可能是自己。