如何透過VBA隨機"萬中取一"(但不能重複),抽完一萬次
- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
本帖最後由 stillfish00 於 2014-8-20 09:30 編輯
回復 7# GBKEE
思慮不周:L ，應該是
r = Int(Rnd * (UBound(ar) - i+1)) + i- Sub test() '隨機取出指定個數的不重複
- Dim ar, num As Long, r, tmp
-
- ar = [D1:D10000].Value '原始資料(必須是不重複值)
- num = 10000 '設定取幾個值
-
- Randomize '初始化隨機函數Rnd()的種子
- For i = 1 To num
- '從i到最後一筆取出一個
- r = Int(Rnd * (UBound(ar) - i + 1 )) + i
- '取到的換到前面
- tmp = ar(r, 1)
- ar(r, 1) = ar(i, 1)
- ar(i, 1) = tmp
- Next
-
- '依序結果到F欄
- [F1].Resize(num) = ar
- End Sub
|
|
|
|
|
|
|
|
- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
8#
發表於 2014-8-20 08:36
| 只看該作者
回復 7# GBKEE
抱歉，少了括號
r = Int(Rnd * (UBound(ar) - i)) + i
感謝指正!! |
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
7#
發表於 2014-8-19 20:34
| 只看該作者
回復 6# stillfish00 - r = Int(Rnd * UBound(ar) - i) + i
|
|
|
|
|
|
|
|
- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
6#
發表於 2014-8-19 17:12
| 只看該作者
本帖最後由 stillfish00 於 2014-8-19 17:15 編輯
供參考:- Sub test() '隨機取出指定個數的不重複
- Dim ar, num As Long, r, tmp
-
- ar = [D1:D10000].Value '原始資料(必須是不重複值)
- num = 10000 '設定取幾個值
-
- Randomize '初始化隨機函數Rnd()的種子
- For i = 1 To num
- '從i到最後一筆取出一個
- r = Int(Rnd * UBound(ar) - i) + i
- '取到的換到前面
- tmp = ar(r, 1)
- ar(r, 1) = ar(i, 1)
- ar(i, 1) = tmp
- Next
-
- '依序結果到F欄
- [F1].Resize(num) = ar
- End Sub
|
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
|
5#
發表於 2014-8-18 16:39
| 只看該作者
本帖最後由 GBKEE 於 2014-8-19 20:16 編輯
回復 4# PKKO
還有可參考一下- Option Explicit
- Sub Ex1()
- Application.ScreenUpdating = True
- Dim i As Long, Msg As Integer
- Randomize ' 對亂數產生器做初始化的動作。
- For i = 1 To 10000
- Do
- Cells(i, "a") = Int(10000 * Rnd + 1) '亂數號碼
- Msg = Application.CountIf([a1:a10000], Cells(i, "a"))
- DoEvents
- Loop Until Msg = 1
- Next
- End Sub
- '******************************
- Sub Ex()
- Dim d As Object, y As Integer, A
- Set d = CreateObject("scripting.dictionary")
- Randomize ' 對亂數產生器做初始化的動作。
- Do
- y = Int(10000 * Rnd + 1)
- d(y) = y
- Loop Until d.Count = 10000
- Range("A1").Resize(10000) = Application.Transpose(d.ITEMS)
- End Sub
|
|
|
|
|
|
|
|
- 帖子
- 549
- 主題
- 152
- 精華
- 0
- 積分
- 691
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-8-10
- 最後登錄
- 2022-9-7
 
|
4#
發表於 2014-8-18 14:17
| 只看該作者
回復 3# PKKO
因為我在公司不能上傳附件,小弟附上程式碼以及公式
因為vba還不熟悉的關係,配合函數使用= =請別見怪
1.先在b11的位置輸入=IFERROR(VLOOKUP(B10,F:F,1,FALSE),"NO")
2.將data放置在d欄
3.執行巨集- Sub test()
-
- Application.ScreenUpdating = False
- Dim x As Long
- Dim y As Long
- Columns("F:F").ClearContents
- x = WorksheetFunction.CountA(Range("d:d"))
- i = 1
- Do While i <= x
- Randomize ' 對亂數產生器做初始化的動作。
- y = Int((x - 1 + 1) * Rnd + 1) '亂數號碼
- Cells(10, 2).Value = Cells(y, 4).Value
- If Cells(11, 2).Value = "NO" Then '如果重複則重新跑回圈(i部會+1)
- Cells(i, 6).Value = Cells(10, 2).Value '如果沒有重複則將DATA放在F欄
- i = i + 1
- End If
- Loop
- End Sub
|
|
|
PKKO
|
|
|
|
|
- 帖子
- 549
- 主題
- 152
- 精華
- 0
- 積分
- 691
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-8-10
- 最後登錄
- 2022-9-7
|
3#
發表於 2014-8-18 09:30
| 只看該作者
|
感謝大大,小弟將程式改編,已經可以正常使用,非常感激^_^ |
|
|
PKKO
|
|
|
|
|
