ダミーテーブル作成 ① 前編

昨日は、テスト用の表を作成するために、「テキトー」（※「適当」ではない）な名前の社名を作って返す関数を作成してみた。
infoment.hatenablog.com

今日はこれを元に、いよいよダミーテーブル作成に挑戦する。

兎に角「無作為感」を出したかったので、RandBetween関数を乱用してしまった。もっとスマートな方法もあるのだろうが、今回は手軽にこれで済ませた。

Sub CriateDammyTable(Optional record_number As Long = 10)
    ' 架空の会社名格納用配列。
    Dim FictitiousCompanys() As String
    ' 会社名の数は、レコード数の二分の一とする（切り下げ）。
    ReDim FictitiousCompanys(1 To WorksheetFunction.RoundDown(record_number / 2, 0))
    Dim i As Long
    ' 架空の会社名で配列作成。
        For i = 1 To UBound(FictitiousCompanys)
            FictitiousCompanys(i) = FictitiousName
        Next
    ' テーブルのラベル用配列。
    Dim LabelArray As Variant
        LabelArray = Array("No.", "顧客名", "商品コード", "商品名", "数量", "単価", "合計金額", "受注日", "約定納期", "納入日")
    Dim arr() As Variant
    ReDim arr(0 To record_number, 1 To UBound(LabelArray) + 1)
    
    ' ０行目にラベルセット。
        For i = 0 To UBound(LabelArray)
            arr(0, i + 1) = LabelArray(i)
        Next
    
    ' 商品コードと品名等の辞書作成。5品番作成。
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
        For i = 1 To 5
            ' 配列内は商品コード，商品名，単価の順。
            Dict(1) = Array(1000, "りんご", 100)
            Dict(2) = Array(1001, "みかん", 200)
            Dict(3) = Array(1002, "ばなな", 150)
            Dict(4) = Array(1003, "なし", 400)
            Dict(5) = Array(1004, "もも", 300)
        Next
    
    ' レコード作成。
    Dim CompanyIndex As Long
    Dim ItemIndex As Long
        For i = 1 To record_number
        ' No.
        ' 顧客名。
            CompanyIndex = WorksheetFunction.RandBetween(1, UBound(FictitiousCompanys))
            arr(i, 2) = FictitiousCompanys(CompanyIndex)
        ' 商品コード。
            ItemIndex = WorksheetFunction.RandBetween(1, 5)
            arr(i, 3) = Dict(ItemIndex)(0)
        ' 商品名。
            arr(i, 4) = Dict(ItemIndex)(1)
        ' 数量。
            arr(i, 5) = WorksheetFunction.RandBetween(1, 20)
        ' 単価。
            arr(i, 6) = Dict(ItemIndex)(2)
        ' 合計金額。
        ' 受注日。今日から３０日以内。
            arr(i, 8) = Date + WorksheetFunction.RandBetween(1, 30)
        ' 約定納期。受注日＋３～＋７日。
            arr(i, 9) = arr(i, 8) + WorksheetFunction.RandBetween(3, 7)
        ' 納入日。約定納期±２日。
            arr(i, 10) = arr(i, 9) + WorksheetFunction.RandBetween(-2, 2)
        Next
        
        Range("A1").Resize(record_number + 1, 10) = arr
End Sub

それでは、テストしてみよう。

思いのほか手間取り、今日はここで時間切れ。
明日の「後編」（「中編」かも）に続きます。

参考まで。