2008-01-25

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
Related Posts Plugin for WordPress, Blogger...

沒有留言 :

張貼留言

,,