ピボットテーブル練習用データ 作成コード

スポンサーリンク

こちらは、Tips集「【超簡単】ピボットテーブルを使ってみよう」で利用する、「寝具屋さん売上げデータ」の作成用コードです。こちらをコピペして、ご利用ください。

Option Explicit
  
Sub 寝具屋さん売上げデータ作成()
    Dim i As Long   '日付
    Dim j As Long   '売上げ情報シートの行数
    Dim k As Long   '単価テーブルシートの行数
    
    Dim 店舗(3) As String    '店舗リスト
    Dim l As Long   '店舗リストのインデックス
    
    Dim d As Double 'Rndで取得した乱数を、代入するための変数
     
     
    '処理高速化・チカチカさせないようにする===========
    Application.ScreenUpdating = False
     
     
    'ワークブック・シートの準備=======================
    Dim wb As Workbook
    Dim s売上げ情報 As Worksheet
    Dim s単価テーブル As Worksheet
     
    Set wb = ThisWorkbook
    wb.Worksheets.Add
     
    wb.Worksheets(1).Name = "売上げ情報"
    wb.Worksheets(2).Name = "単価テーブル"
     
    Set s売上げ情報 = wb.Worksheets("売上げ情報")
    Set s単価テーブル = wb.Worksheets("単価テーブル")
     
     
    'ヘッダの付与=====================================
    s売上げ情報.Cells(1, 1).Value = "月日"
    s売上げ情報.Cells(1, 2).Value = "商品"
    s売上げ情報.Cells(1, 3).Value = "個数"
    s売上げ情報.Cells(1, 4).Value = "売上げ金額"
    s売上げ情報.Cells(1, 5).Value = "店舗"
     
    s単価テーブル.Cells(1, 1).Value = "商品"
    s単価テーブル.Cells(1, 2).Value = "単価"
     
     
    '単価テーブルシートの作成=========================
    s単価テーブル.Cells(2, 1).Value = "敷き布団"
    s単価テーブル.Cells(2, 2).Value = 20000
     
    s単価テーブル.Cells(3, 1).Value = "掛け布団"
    s単価テーブル.Cells(3, 2).Value = 15000
     
    s単価テーブル.Cells(4, 1).Value = "マットレス"
    s単価テーブル.Cells(4, 2).Value = 10000
     
    s単価テーブル.Cells(5, 1).Value = "枕"
    s単価テーブル.Cells(5, 2).Value = 5000
     
    '単価列を、カンマ付きに編集----------
    For k = 2 To s単価テーブル.Cells(s単価テーブル.Rows.Count, 1).End(xlUp).Row
        s単価テーブル.Cells(k, 4).Style = "Comma [0]"
    Next
     
    '列の幅を調整------------------------
    s単価テーブル.Columns("A:B").EntireColumn.AutoFit
     
     
     
    '売上げ情報シートの作成===========================
    
    '店舗リストに値を代入-----------------------------
    店舗(0) = "東口店"
    店舗(1) = "西口店"
    店舗(2) = "北口店"
    店舗(3) = "南口店"
    
    
    'Rnd(乱数発生)を利用し、売上げデータを入力------
    j = 2
    For i = 1 To 7
        
        For l = 0 To UBound(店舗)
            d = Rnd
            If d >= 0.3 Then
                s売上げ情報.Cells(j, 1).Value = "2021/7/" & Str(i)
                s売上げ情報.Cells(j, 2).Value = "敷き布団"
                s売上げ情報.Cells(j, 3).Value = Int(d * 10) - 2
                s売上げ情報.Cells(j, 4).Value = s売上げ情報.Cells(j, 3).Value * s単価テーブル.Cells(2, 2).Value
                s売上げ情報.Cells(j, 5).Value = 店舗(l)
                j = j + 1
            End If
            
            d = Rnd
            If d >= 0.3 Then
                s売上げ情報.Cells(j, 1).Value = "2021/7/" & Str(i)
                s売上げ情報.Cells(j, 2).Value = "掛け布団"
                s売上げ情報.Cells(j, 3).Value = Int(d * 10) - 2
                s売上げ情報.Cells(j, 4).Value = s売上げ情報.Cells(j, 3).Value * s単価テーブル.Cells(3, 2).Value
                s売上げ情報.Cells(j, 5).Value = 店舗(l)
                j = j + 1
            End If
            
            d = Rnd
            If d >= 0.3 Then
                s売上げ情報.Cells(j, 1).Value = "2021/7/" & Str(i)
                s売上げ情報.Cells(j, 2).Value = "マットレス"
                s売上げ情報.Cells(j, 3).Value = Int(d * 10) - 1
                s売上げ情報.Cells(j, 4).Value = s売上げ情報.Cells(j, 3).Value * s単価テーブル.Cells(4, 2).Value
                s売上げ情報.Cells(j, 5).Value = 店舗(l)
                j = j + 1
            End If
            
            d = Rnd
            If d >= 0.3 Then
                s売上げ情報.Cells(j, 1).Value = "2021/7/" & Str(i)
                s売上げ情報.Cells(j, 2).Value = "枕"
                s売上げ情報.Cells(j, 3).Value = Int(d * 10) + 5
                s売上げ情報.Cells(j, 4).Value = s売上げ情報.Cells(j, 3).Value * s単価テーブル.Cells(5, 2).Value
                s売上げ情報.Cells(j, 5).Value = 店舗(l)
                j = j + 1
            End If
        Next
    Next
     
    '売上げ金額列を、カンマ付きに編集-----------------
    For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
        Cells(i, 4).Style = "Comma [0]"
    Next
     
    '列の幅を調整-------------------------------------
    s売上げ情報.Columns("A:E").EntireColumn.AutoFit
     
     
    '処理が終わったので、ScreenUpdatingを戻す=========
    Application.ScreenUpdating = True
     
     
    MsgBox "終わったでー"
      
End Sub
タイトルとURLをコピーしました