Excel 隨機取行的 VBA

因為別人有需要，隨手寫了一個隨機取 excel 資料比數的 VBA 程式。

適用範圍，需隨機在大量資料中取出固定筆數的，像在 100筆資料中要取出5筆。


本 VBA 含三個部分：

1. Setting ： 會在 Sheet3 中做一個初始的設定，可自行隨意變更資料總數和隨機取的數目。


2. TestCaseInit: 做一個測試的例子的初始化


3. Choice: 隨出選出  想要的資料量

Setting 這一個 sub 主要是用來做初始化的程式。執行此程式後，會在 sheet3 中產生資料。產生資料後，就可依自己的需求去變更 資料總算數的值 和 想隨機取的資料筆數。

Sub Setting()
        Sheet3.Cells(1, 1).Value = "資料總筆數"
        Sheet3.Cells(1, 2).Value = 20
        Sheet3.Cells(3, 1).Value = "想隨機取的資料筆數"
        Sheet3.Cells(3, 2).Value = 6
End Sub

TestCaseInit 是筆者用來測試用的資料，執行後會依據 Setting 中的資料總筆數自動在 Sheet1 中建出足夠的測試資料。

Sub TestCaseInit()
    Dim AData
    AData = Fix(Sheet3.Cells(1, 2).Value)
    Randomize
    For i = 1 To AData
        Sheet1.Cells(i, 1).Value = i
        Sheet1.Cells(i, 2).Value = "大頭大頭"
    Next
End Sub

Choice 這一個 Sub 就是用來選資料的，在執行本巨集前，請先執行 Setting 巨集。本巨集會將選取的資料從 Sheet1 移動到 Sheet2 資料表中。

變數說明如下：

• numChoice： 想要選取的資料數，由 Sheet3 中取得資料。


• AData：資料的總數，由 Sheet3 中取得資料


• mychoice：用來存放產生的隨機變數

 

Sub Choice()
    Dim mychoice, numChoice, AData
    Randomize
    AData = Fix(Sheet3.Cells(1, 2).Value)
    numChoice = Fix(Sheet3.Cells(3, 2).Value)


    For i = 1 To numChoice
       mychoice = Fix(Int(AData - i + 1) * Rnd) + 1
       Sheet1.Activate
          
       Rows(mychoice).Copy
       ActiveSheet.Paste Destination:=Sheet2.Rows(i)
     
       Rows(mychoice & ":" & mychoice).Select
       Selection.Delete Shift:=xlUp
    Next


End Sub