組み合わせごとの集計の仕方を教えてください

質問

エクセルでの集計の仕方を教えてください。
分類A～Cの中からそれぞれ好きなものを１つずつ選択してもらい１セットで売るという商品があるとします（３品１セット）。
受注データを集計し、人気の組み合わせをランク付けしたい場合どのような方法があるでしょうか？

分類 　品番　　 品名
A 　　　A1　　 Tシャツ１
　　　　A2　　 Tシャツ2
B 　　　B1　　 ジャケット1
　　　　B2　　 ジャケット2
C 　　　C1　 　スカート1
　　　　C2　　 スカート2

受注データは以下のような形で出ます。
<受注データ>
注文番号 　品番 　品名 　　　　数量
1001 　　　A1 　　Tシャツ１　 　1
1001　　　 B1 　　ジャケット1 　1
1001 　　　C2 　　スカート2 　　1
1002　　　 A2 　　Tシャツ2 　　 1
1002 　　　B2 　　ジャケット2　 1
1002 　　　C2 　　スカート2 　 1
1003 　　　A2 　　Tシャツ2　　　1
1003　　　 B2 　　ジャケット2 　1
1003 　　　C2 　　スカート2　　 1
1004 　　　A1 　　Tシャツ１ 　 1
1004　　　 B1 　　ジャケット1　 1
1004　　　 C2 　　スカート2 　　1
1005 　　　A1　　 Tシャツ１ 　 1
1005　　　 B1 　　ジャケット1　 1
1005 　　　C2 　　スカート2 　 1
・
・
・
いろいろと試してみたのですがなかなかうまくいきません。
組み合わせごとの集計というところがポイントです。
どうぞよろしくお願いいたします。

回答No.3

hallo-2007 · ベストアンサー

受注データが必ず受注番号順で　ABC順に並んでいるのであれば
　　A　　　　B　　　C　　　　　D　　　　E
注文番号 　品番 　品名 　　　　数量　組み合わせ
1001 　　　A1 　　Tシャツ１　 　1
1001　　　 B1 　　ジャケット1 　1
1001 　　　C2 　　スカート2 　　1
E2に組み合わせ　とでもいれて
E3セルには　=OFFSET(B$1,ROW(A1)*3-2,0)&OFFSET(B$1,ROW(A1)*3-1,0)&OFFSET(B$1,ROW(A1)*3,0)
コピィして下フィルしてみてください。
データの3行を1行にまとめます。
後は、E列を選択してピボットテーブル作成すれば、ご希望の数値がでると思います。

お礼

大変たすかりました。
これで先が見えました。
本当にどうもありがとうございました！

回答No.5

mitarashi

A No.2です。
組み合わせの中の数量はいつも同じと決めてかかっておりました。もし、異なる場合があるならば、下記の様なコードになります。dictionaryに複数データを持たせるために、クラスを使用しています。面倒くさくなって本末転倒かも．．．ご参考まで。
＜標準モジュール＞
Sub test()
Dim targetRange As Range, destRange As Range
Dim myDic As Object, myKey As Variant
Dim i As Long, clsID As Long
Dim keyString As String
Dim splitArray As Variant
Dim combiCls() As combinationClass
Dim fieldArray As Variant

Set targetRange = ActiveSheet.Range("A1").CurrentRegion
Set myDic = CreateObject("Scripting.Dictionary")
ReDim combiCls(0 To 0)
For i = 2 To targetRange.Rows.Count Step 3
keyString = targetRange.Cells(i, 2).Value & "☆" & targetRange.Cells(i + 1, 2).Value & _
"☆" & targetRange.Cells(i + 2, 2).Value
If Not myDic.exists(keyString) Then
clsID = clsID + 1
ReDim Preserve combiCls(clsID)
Set combiCls(clsID) = New combinationClass
With combiCls(clsID)
.addShirts targetRange.Cells(i, 4).Value
.addJackets targetRange.Cells(i + 1, 4).Value
.addSkirts targetRange.Cells(i + 2, 4).Value
End With
myDic.add keyString, combiCls(clsID)
Else
With myDic.Item(keyString)
.addShirts targetRange.Cells(i, 4).Value
.addJackets targetRange.Cells(i + 1, 4).Value
.addSkirts targetRange.Cells(i + 2, 4).Value
End With
End If
Next i
'値の取り出し
myKey = myDic.keys
fieldArray = Array("シャツ", "ジャケット", "スカート", "シャツ数", "ジャケット数", "スカート数")
Set destRange = ActiveSheet.Range("F1")
destRange.Resize(1, 6) = fieldArray
Set destRange = destRange.Offset(1, 0)
For i = 0 To myDic.Count - 1
splitArray = Split(myKey(i), "☆")
With destRange
.Value = splitArray(0)
.Offset(0, 1).Value = splitArray(1)
.Offset(0, 2).Value = splitArray(2)
.Offset(0, 3).Value = myDic(myKey(i)).shirtsCount
.Offset(0, 4).Value = myDic(myKey(i)).jacketsCount
.Offset(0, 5).Value = myDic(myKey(i)).skirtsCount
End With
Set destRange = destRange.Offset(1, 0)
Next i
Set myDic = Nothing
End Sub
以下はクラスモジュールですので、VBEで挿入／クラスモジュールとして、下記のコードを貼り付け、オブジェクト名を、combinationClassに変更してください。中味は、個数を足し算して保存し、読み出す事ができるというだけの内容です。
＜クラスモジュール＞
Option Explicit
Private myShirtsCount As Long
Private myJacketsCount As Long
Private mySkirtsCount As Long
Private myName As String

Public Sub addShirts(newShirtsCount As Long)
myShirtsCount = myShirtsCount + newShirtsCount
End Sub
Public Sub addJackets(newJacketsCount As Long)
myJacketsCount = myJacketsCount + newJacketsCount
End Sub
Public Sub addSkirts(newSkirtsCount As Long)
mySkirtsCount = mySkirtsCount + newSkirtsCount
End Sub
Public Property Get shirtsCount() As Long
shirtsCount = myShirtsCount
End Property
Public Property Get jacketsCount() As Long
jacketsCount = myJacketsCount
End Property
Public Property Get skirtsCount() As Long
skirtsCount = mySkirtsCount
End Property

お礼

２度もありがとうございます。
ただ、今の私には難しくて・・・
今後勉強したいと思います。どうもありがとうございました！

回答No.4

kuma56

まずは、確認ね。
>受注データは以下のような形で出ます。
><受注データ>
っとありますが、注文番号は必ず3行ですね。
品番と品名は関連付けられているだろうから問題ないけど、数量は必ず１ですか?
つまり
注文番号 　品番 　品名 　　　　数量
1001 　　　A1 　　Tシャツ１　 　1
1001　　　 B1 　　ジャケット1 　2
こう↑はならずに、こう↓なりますね
1001 　　　A1 　　Tシャツ１　 　1
1001　　　 B1 　　ジャケット1 　1
1001　　　 B1 　　ジャケット1 　1

さらに、品番（＆品名）はソートされていますか？

1002　　　 A2 　　Tシャツ2 　　 1
1002 　　　B2 　　ジャケット2　 1
1002 　　　C2 　　スカート2 　 1
こう↑なって、こう↓はなりませんよね。
1002 　　　C2 　　スカート2 　 1
1002 　　　B2 　　ジャケット2　 1
1002　　　 A2 　　Tシャツ2 　　 1

んで・・・VBA　は判りますか？？

具体的なVBAの構文は確認していませんが、こんな手順で作業できるでしょう。
まずは注文番号～数量までのデータの部分を全部どこか別のシートにコピーする（仮にsheet2のＡ１セルを基準とします）。
　　Ａ　　　　Ｂ　　　Ｃ　　　　　Ｄ　
１　1001 　　　A1 　　Tシャツ１　 　1
２　1001　　　 B1 　　ジャケット1 　1
３　1001 　　　C2 　　スカート2 　　1
４　1002　　　 A2 　　Tシャツ2 　　 1
５　1002 　　　B2 　　ジャケット2　 1
６　1002 　　　C2 　　スカート2 　 1
７　1003 　　　A2 　　Tシャツ2　　　1
８　1003　　　 B2 　　ジャケット2 　1
９　1003 　　　C2 　　スカート2　　 1
・Ａ１セルのみをコピーしてＥ１セルに貼り付ける
・Ｂ１セル～Ｂ３セルを選択して、Ｆ１セルに行列を入れ替えて貼り付ける。
・Ａ１セルからＤ列の最下端（未入力セルも含めて）を選択して、Ａ１セルに張り付ける。→　Ａ１セルが 1002 になる。
・この作業をＡ列のデータがなくなるまで繰り返すと、↓こうなる。
　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ
１1001 A1 B1 C2
２1002 A2 B2 C2
３1003 A2 B2 C2
・Ｆ列・Ｇ列・Ｈ列をキーにソートする。→　同じ組み合わせのデータ同士が上下につながって並ぶ。
・Ｉ１セルに、数値 1 を入力して、Ｉ２セルに関数式 =IF(AND(F2=F1,G2=G1,H2=H1),+I1+1,1) を入力。　　
・Ｉ２セルをコピーして、下方（Ｅ～Ｈ列の入力済みの最下端とおなじ行のＩ列まで）に貼り付けると、↓こうなる。
　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ
１1001 A1 B1 C2 1
２1002 A2 B2 C2 1
３1003 A2 B2 C2 2

・Ｊ１セルにＫＩＦ関数式で、Ｆ列・Ｇ列・Ｈ列の値が下のセルと同じ場合は、１、そうでなければ空白とすると、↓こうなる。
　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ
１1001 A1 B1 C2 1 1
２1002 A2 B2 C2 1
３1003 A2 B2 C2 2 1
・Ｉ列・Ｊ列をコピーペーストで値に直し、Ｊ列（昇順）・Ｉ列（降順）をキーにしてソートする。
・Ｊ列に値の入っていない行の値を削除すると、↓こうなる。
　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ
１1003 A2 B2 C2 2 1
２1001 A1 B1 C2 1 1

Ｅ列に注文番号が歯抜けで残りますが、気になるなら削除してください。

こんな手順でマクロ化すれば、希望のデータが取れると思いますよ。

回答No.2

mitarashi

最近個人的に、はまっているdictionaryシリーズです
下記の様なActiveSheetに、集計結果をF1に出力します。
ご参考まで。
...................A.......B...............C.......D
..1.注文番号.品番.........品名.数量
..2...........1001......A1Tシャツ１........1
..3...........1001......B1ジャケット1........1
..4...........1001.....C2スカート2........1

Sub test()
Dim targetRange As Range, destRange As Range
Dim myDic As Object, myKey As Variant
Dim i As Long
Dim keyString As String
Dim splitArray As Variant

Set targetRange = ActiveSheet.Range("A1").CurrentRegion
Set myDic = CreateObject("Scripting.Dictionary")
For i = 2 To targetRange.Rows.Count Step 3
keyString = targetRange.Cells(i, 2).Value & "☆" & targetRange.Cells(i + 1, 2).Value & _
"☆" & targetRange.Cells(i + 2, 2).Value
If Not myDic.exists(keyString) Then
myDic.Add keyString, targetRange.Cells(i, 4).Value
Else
myDic.Item(keyString) = myDic.Item(keyString) + targetRange.Cells(i, 4).Value
End If
Next i
myKey = myDic.keys
Set destRange = ActiveSheet.Range("F1")
For i = 0 To myDic.Count - 1
splitArray = Split(myKey(i), "☆")
destRange.Value = splitArray(0)
destRange.Offset(0, 1).Value = splitArray(1)
destRange.Offset(0, 2).Value = splitArray(2)
destRange.Offset(0, 3).Value = myDic(myKey(i))
Set destRange = destRange.Offset(1, 0)
Next i
Set myDic = Nothing
End Sub

回答No.1

noname#77348

セット(組み合わせ)に対して、一意のコード(品番)を設定すべきです。

つまり、現在の受注Dataではだめだということです。

コンピュータがやることですから、そういうお膳立てが必要です。

それで解決すると思いますが。

以上