VBAでボリュームデータのランダム作成

要件

性能テストのため、ボリュームデータが必要ですが、本番データがとれない場合、何十万、百万のデータ作成
になります。Excel自身で１００万レコードを表示できるが、手で埋めることは無理です。もう一つは区分、日付はバランス的にうめることは容易ではない。

案

・順番できるデータは１から増やせる
　　→SEQ型で、先頭文字を指定する
・区分データはランダム関数を使う。
　→List型で、区分は配列に入れ、配列「区分数＊Rand」で取ると、バランス的に使われる
　　区分が一つしかない場合、固定値になる

実装

　・シートに特別文字ないと、対象シートではないと判断する
　　例：Cells(1, 2)に”TestData”がマークとする
　・作成行数を指定する
　　例：Cells(4, 4)に25件とする
　・テーブル定義が横に置く
　・データ指定、開始行列は下記ようにする
　　

ソース

Sub MakeData()
 Set wks = ActiveSheet
 If wks.Cells(1, 2) <> "TestData" Then
  MsgBox "You Should use TestData Sheet"
  Exit Sub
 End If
 
 cnt = wks.Cells(4, 4)
 
 jj = 4
 ii = 10
 tbn = wks.Cells(3, 3)
 While wks.Cells(6, jj) <> ""
   cnm = wks.Cells(6, jj)
   tp = wks.Cells(8, jj)
   iniv = wks.Cells(9, jj)
   If tp = "SEQ" Then
    
     For kk = 1 To cnt
       wks.Cells(9 + kk, jj) = iniv & Right("000000" & kk, 6)
     Next kk
   End If
    If tp = "List" Then
      lstv = Split(iniv, ";")
      lstn = UBound(lstv) + 1
    
     For kk = 1 To cnt
       Randomize
       wks.Cells(9 + kk, jj) = lstv(Int(lstn * Rnd))
     Next kk
   End If
 

 
   jj = jj + 1
 Wend
MsgBox "set data ok"
End Sub

おまけ

　JsonデータとJavaまたJavaScript用の形式を生成

'make array of json data\
Sub MakeJson()
Set wks = ActiveSheet
 If wks.Cells(1, 2) <> "TestData" Then
  MsgBox "You Should use TestData Sheet"
  Exit Sub
 End If
 
 jstr = "["
 apexStr = "'['"
 
 jj = 4
 ii = 10
 lstr = ""
 vall = "" 'all values for the line
 lcnt = 0
 tbn = wks.Cells(3, 3)
NEXTII:
 While wks.Cells(6, jj) <> ""
   cnm = wks.Cells(6, jj)
   tp = wks.Cells(8, jj)
   vv = Trim(wks.Cells(ii, jj))
   vall = vall & vv
   If tp <> "" Then
     cellstr = Chr(34) & cnm & Chr(34) & ":" & Chr(34) & vv & Chr(34)
     If lstr = "" Then
      lstr = "{" & cellstr
     Else
      lstr = lstr & "," & cellstr
     End If
   End If
 jj = jj + 1
 Wend
 If Len(vall) > 2 Then
  If lcnt = 0 Then
   jstr = jstr & " " & lstr & "}" & vbLf
   apexStr = apexStr & vbLf & " +'" & lstr & "}'" & vbLf
  Else
   jstr = jstr & "," & lstr & "}" & vbLf
   apexStr = apexStr & "+ '," & lstr & "}'" & vbLf

  End If
  lcnt = lcnt + 1
  ii = ii + 1
  jj = 4
  vall = ""
  lstr = ""
  GoTo NEXTII
 Else
  jstr = jstr & "]"
  apexStr = apexStr & "+ ']'"

 End If
  
 wks.Cells(1, 3) = jstr
 wks.Cells(1, 4) = apexStr
 
 MsgBox "make json ok" & apexStr


End Sub