Hsieh

回復 1# PKKO
10000不重複取值

1. Sub ex()
   
2. Set d = CreateObject("Scripting.dictionary")
   
3. Ar = [A1:A10000].Value
   
4. Do Until d.Count = 10000
   
5. Randomize
   
6. k = Int(10000 * Rnd + 1)
   
7. d(k) = Ar(k, 1)
   
8. Loop
   
9. [B1].Resize(10000, 1) = Application.Transpose(d.items)
   
10. Set d = Nothing
    
11. End Sub

複製代碼

至於1000000次
3欄各100格資料

1. Sub nn()
   
2. Dim ar(1000000, 3)
   
3. t = Timer
   
4. For Each a In [A1:A100]
   
5.    For Each b In [B1:B100]
   
6.       For Each c In [C1:C100]
   
7.          ar(s, 0) = a: ar(s, 1) = b: ar(s, 2) = c
   
8.          s=s+1
   
9.       Next
   
10.     Next
    
11.     Next
    
12.     [D1].Resize(1000000, 3) = ar
    
13.     MsgBox Timer - t  '共花費的時間秒數
    
14. End Sub

複製代碼