エクセル練習問題:クロス集計表の作成(VBA)

問題 topへ

• 問題1:Sheet1に下表のデータがあります。Sheet2のクロス集計表を完成しなさい。 問題1の解答
  • Sheet1のデータ
    
    B C D
    2 販売先 商品名 販売額
    3 井上商事 りんご 52,000
    4 上田青果 りんご 65,000
    5 井上商事 みかん 78,000
    6 上田青果 みかん 43,000
    7 井上商事 りんご 45,000
    8 上田青果 バナナ 57,000
    9 井上商事 バナナ 49,000
    10 上田青果 りんご 80,000
  • Sheet2の状態は下表の通りです。ピンクのセルに数式を入れて完成しなさい。
    
    B C D E
    2 バナナ みかん りんご
    3 井上商事
    4 上田青果

解答例 topへ

問題1の解答例 topへ

1. ワークシート関数SUMIFSを利用した例です。(Excel2007以降)
   
   Sub test50()
   Dim i As Long, j As Long
   With Worksheets("Sheet1")
   For i = 3 To 4
   For j = 3 To 5
   Cells(i, j).Value = Application.WorksheetFunction. _
   SumIfs(.Range("D3:D10"), .Range("B3:B10"), Cells(i, 2), .Range("C3:C10"), Cells(2, j))
   Cells(i, j).NumberFormatLocal = "#,##0"
   Next j
   Next i
   End With
   End Sub
2. For〜Nextで条件と一致したデータの値を合計する例です。
   • myVal = sh1.Range("B3:D10").Value の配列myValは下図のような位置関係になります。
     
     B C D
     2
     3 myVal(1, 1) myVal(1, 2) myVal(1, 3)
     4 myVal(2, 1) myVal(2, 2) myVal(2, 3)
     5 myVal(3, 1) myVal(3, 2) myVal(3, 3)
     6 myVal(4, 1) myVal(4, 2) myVal(4, 3)
     7 myVal(5, 1) myVal(5, 2) myVal(5, 3)
     8 myVal(6, 1) myVal(6, 2) myVal(6, 3)
     9 myVal(7, 1) myVal(7, 2) myVal(7, 3)
     10 myVal(8, 1) myVal(8, 2) myVal(8, 3)
   Sub test51()
   Dim myVal
   Dim i As Long, j As Long, k As Long
   Dim goukei As Double
   Dim sh1 As Worksheet
   Set sh1 = Worksheets("Sheet1")
   ' ---元データを配列に格納
   myVal = sh1.Range("B3:D10").Value
   ' ---条件一致データを合計する
   For i = 3 To 4
   For j = 3 To 5
   goukei = 0
   For k = 1 To UBound(myVal)
   If myVal(k, 1) = Cells(i, 2).Value And myVal(k, 2) = Cells(2, j).Value Then
   goukei = goukei + myVal(k, 3)
   End If
   Next k
   Cells(i, j).Value = goukei
   Cells(i, j).NumberFormatLocal = "#,##0"
   Next j
   Next i
   
   Set sh1 = Nothing
   End Sub
3. Dictionaryオブジェクトを利用した例です。
   
   Sub test51()
   Dim myDic As Object, myKey, myItem
   Dim myVal, myVal2, myVal3
   Dim i As Long, j As Long
   Dim sh1 As Worksheet
   Set myDic = CreateObject("Scripting.Dictionary")
   Set sh1 = Worksheets("Sheet1")
   ' ---元データを配列に格納
   myVal = sh1.Range("B3:D10").Value
   ' ---myDicへデータを格納
   For i = 1 To UBound(myVal, 1)
   myVal2 = myVal(i, 1) & "_" & myVal(i, 2)
   If Not myVal2 = "_" Then
   If Not myDic.exists(myVal2) Then
   myDic.Add myVal2, myVal(i, 3)
   Else
   myDic(myVal2) = myDic(myVal2) + myVal(i, 3)
   End If
   End If
   Next
   ' ---Key,Itemの書き出し
   For i = 3 To 4
   For j = 3 To 5
   Cells(i, j).Value = myDic(Cells(i, 2).Value & "_" & Cells(2, j).Value)
   Cells(i, j).NumberFormatLocal = "#,##0"
   Next j
   Next i
   
   Set myDic = Nothing
   Set sh1 = Nothing
   End Sub