返回列表 上一主題 發帖

大量資料排名

大量資料排名

各位先進好
我想要把H欄位裡排名顯示在J欄
但因為資料太多常常會有達50萬個數字(資料數不一定)
用函數方式處理常常會當掉
不知如何改成VBA的方式自動計算
函數式:"=IF(H6="",0,SUMPRODUCT(($H$6:$H$500000>=H6)*(1/COUNTIF(H$6:H$500000,H$6:H$500000))))"

1100927-排名.rar (540.57 KB)

  1. Sub zz()
  2. Dim d As Object, a, k, t, xL As Object, n&
  3. Set xL = CreateObject("System.collections.arraylist")
  4. Set d = CreateObject("scripting.dictionary")
  5. a = Range("h6:h" & [h1048576].End(3).Row)
  6. For Each k In a
  7.     d(k) = ""
  8. Next
  9. For Each k In d.keys
  10.     xL.Add k
  11. Next
  12. xL.Sort: b = xL.Toarray()
  13. n = UBound(b)
  14. For i = 1 To UBound(a)
  15.     For j = 0 To n
  16.         If a(i, 1) <= b(j) Then a(i, 1) = n + 1 - j: Exit For
  17.     Next
  18. Next
  19. [i6].Resize(i - 1) = a
  20. End Sub
複製代碼

TOP

回復 1# oak0723-1

請測試看看,謝謝
Sub test()
Dim Arr, Brr, xD, T
Set xD = CreateObject("Scripting.Dictionary")
With Range("h6:h" & Cells(Rows.Count, 8).End(xlUp).Row)
    Brr = .Value
    .Sort key1:=.Item(1), Order1:=2, Header:=2
    Arr = .Value
    .Value = Brr
End With
For i = 1 To UBound(Arr)
    T = Arr(i, 1): If T = "" Then GoTo 98
    If xD(T) = "" Then: n = n + 1: xD(T) = n
98: Next
For i = 1 To UBound(Brr)
    T = Brr(i, 1)
    If T = "" Then Brr(i, 1) = 0: GoTo 99
    Brr(i, 1) = xD(T)
99: Next
Range("i6").Resize(UBound(Brr)) = Brr
End Sub

TOP

回復 1# oak0723-1


請問H欄數值空白時(不是0), 排名為 0嗎?

TOP

回復 4# samwang


    抱歉我沒描述清楚
內容空白有2種情形
1.前後都有數據的空白儲存格-->顯示0,不列入排名
2.數據結束後的空白儲存格-->不列入排名,不作動作,依然是空白

前後都有數據的空白儲存格

Image 3.jpg

數據結束後的空白儲存格

Image 5.jpg

TOP

回復 3# samwang


    你好,感謝你願意熱心協助
我執行後發現

不重新開啟檔案情況下更動數據後再執行程式,發現執行速度會更慢檔案更容易當機
Image 7.jpg

1100927-排名01-3.rar (960.08 KB)

TOP

回復 2# ikboy
你好
謝謝你的熱心協助
這個程式在重複執行,就是不關閉重新開啟,而直接更改數據,使用新的1組數據(內容和數據數量都不同)再執行,速度會更慢更容易當機

TOP

回復 7# oak0723-1


    是否你本身的公式導致? 可改為手動重算試試。
1100927-排名.png

TOP

回復 6# oak0723-1

移除J6 公式再執行程式就可以,請測試看看,謝謝

TOP

回復 9# samwang


    原來是j6公式卡住整體的運算
謝謝你

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題