12
返回列表 上一主題 發帖

如何透過VBA隨機"萬中取一"(但不能重複),抽完一萬次

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-8-16 22:52 | 只看該作者

如何透過VBA隨機"萬中取一"(但不能重複),抽完一萬次

如題,小弟用EXCEL的函數寫得出來
但後來發現EXCEL函數太多了(畢竟一萬個儲存格)
速度會變成慢到不行

所以假設D1:D10000都是不同的值
要如何每次都是隨機在這一萬格裡取一個值
連續執行一萬次
但都不能重複
直到最後一個值被取完結束呢?

PS:取完的同時清除記憶體,因為下次還要繼續執行同樣的程式,避免記憶體不足
不好意思,麻煩各位先進了...
收藏 分享
PKKO

toromru

帖子
20 
主題
5 
精華
0 
積分
25 
點名
0  
作業系統
W7 
軟體版本
2013 
閱讀權限
10 
註冊時間
2015-7-24 
最後登錄
2015-11-20 
18#
發表於 2015-7-27 14:12 | 只看該作者
回復 16# PKKO


    您好
      增加了兩個需求，想詢問。
     
       假設
            1. 如果要將隨機取的值 在 原始資料的X欄位標記已取
            2 在隨機取的前置條件為X欄位未標記的才進行篩選.


       例如:    A為原始資料  B為隨機取的值   X為標記
                  
                 第一次隨選       第二次隨選     第三次隨選         
                    A   X   B             A   X   B            A    X    B
                    1         2             1         1            1    O    3
                    2                        2    O                2     O
                    3                        3                       3

TOP

toromru

帖子
20 
主題
5 
精華
0 
積分
25 
點名
0  
作業系統
W7 
軟體版本
2013 
閱讀權限
10 
註冊時間
2015-7-24 
最後登錄
2015-11-20 
17#
發表於 2015-7-27 13:27 | 只看該作者
回復 16# PKKO


    謝謝  已成功如我需求的抽出 : )

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
16#
發表於 2015-7-24 13:59 | 只看該作者
回復 15# toromru


ar = [D1:D10000].Value
如果純粹是這行,有很多方式
'自動選擇到最下面一列
AR=RANGE("d1:d" & [D65536].END(XLUP).ROW).VALUE
'輸入方式
X1=INPUTBOX("請輸入d欄數字")
AR=RANGE("d1:d" & X1 ).VALUE
'某個位置或是某個變數假設是[A2]
AR=RANGE("d1:d" & [A2] ).VALUE

'這幾個方法都因該要設定偵錯的方式,避免沒有數字、d欄沒有值、[A2]為空等問題~
PKKO

TOP

toromru

帖子
20 
主題
5 
精華
0 
積分
25 
點名
0  
作業系統
W7 
軟體版本
2013 
閱讀權限
10 
註冊時間
2015-7-24 
最後登錄
2015-11-20 
15#
發表於 2015-7-24 13:05 | 只看該作者
回復 11# stillfish00
回復 12# Hsieh
  1.    ar = [D1:D10000].Value  '原始資料(必須是不重複值)
複製代碼
這行 能否自動抓取 D欄位的數量 不要預設10000

例如
我的資料有2000筆 但不一定每次都是2000筆
不想預設每一次都要重新輸入筆數。

TOP

toromru

帖子
20 
主題
5 
精華
0 
積分
25 
點名
0  
作業系統
W7 
軟體版本
2013 
閱讀權限
10 
註冊時間
2015-7-24 
最後登錄
2015-11-20 
14#
發表於 2015-7-24 10:59 | 只看該作者
詢問 #11 與 #12
  1. ar = [D1:D10000].Value  '原始資料(必須是不重複值)
複製代碼
這行 能否自動抓取 D欄位的數量 不要預設10000

例如
我的資料有2000筆 但不一定每次都是2000筆
不想預設每一次都要重新輸入筆數。

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
13#
發表於 2014-8-23 02:10 | 只看該作者
感謝各位大大,時間上真的快多了
看來我得先多學習一下陣列的使用方式
感激不盡!!!
PKKO

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-25 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
12#
發表於 2014-8-22 15:15 | 只看該作者
回復 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
複製代碼
學海無涯_不恥下問

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
11#
發表於 2014-8-21 19:44 | 只看該作者
回復 10# PKKO
僅供參考，不同電腦執行時間也不同
  1. Sub test()
  2.   Dim ar1, ar2, ar3, ar
  3.   Dim i As Integer, j As Integer, k As Integer, n As Long
  4.   Dim t, s As String
  5.   
  6.   t = Timer
  7.   ar1 = [A1:A100].Value
  8.   ar2 = [B1:B100].Value
  9.   ar3 = [C1:C100].Value
  10.   ReDim ar(1 To UBound(ar1) * UBound(ar2) * UBound(ar3), 1 To 1)
  11.   n = 0
  12.   For i = 1 To 100
  13.     For j = 1 To 100
  14.       s = ar1(i, 1) & ar2(j, 1)
  15.       For k = 1 To 100
  16.         n = n + 1
  17.         ar(n, 1) = s & ar3(k, 1)
  18.       Next
  19.     Next
  20.   Next
  21.   
  22.   Debug.Print Timer - t     '小於1秒
  23.   
  24.   Application.ScreenUpdating = False
  25.   [E1].Resize(UBound(ar)).Value = ar    '把結果從array放到工作表上花費最多時間
  26.   Application.ScreenUpdating = True
  27.   
  28.   Debug.Print Timer - t     '約 1X 秒
  29. End Sub
複製代碼

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2014-8-21 14:48 | 只看該作者
回復 9# stillfish00


    大大太厲害了,我看了滿久的還是看不是很懂,為何他不會重複,以及RESIZE的方法是如何應用的

可以再請教您一下:

若是A~C欄都各有一百格資料

我想要進行排列組合,也就是A1 & B1 & C1 然後A2 & B1 & C1 以此類推,每個組合都要有也就是100*100*100=100萬的組合
如何跑最快,我寫的程式跑得有點久...
PKKO

TOP

        靜思自在 : 人事的艱難與琢磨，就是一種考驗。
12
返回列表 上一主題