![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
No.1ベストアンサー
- 回答日時:
例示のデータを集計するなら、ピボットテーブルと関数の合わせ技で実行することがすることができます。
ご使用のエクセルのバージョンが明記されていませんので、例えばExcel2007で説明すると、準備として元データをホームタブの「テーブルとして書式設定」しておきます(これでデータ追加にピボットテーブルが自動的に対応します)。
次に、挿入タブの「ピボットテーブル」から、行ラベルに「番号」、列ラベルとΣ値に「商品」をドラッグしていったんピボットテーブルを作成し、テーブル上を右クリックから「ピボットテーブルオプション」の集計とフィルタタブから行と列の総計を表示するのチェックを外します(添付画像のようなテーブルになります)。
次に添付画像のH2セルに列ラベルの商品名をコピー貼り付けし、縦方向にもG3セル以下に形式を選択して貼り付けで「行と列を入れ替える」で貼り付けます(この商品名は関数でも表示させることができます)。
この表のH3セルに以下の式を入力し、右方向および下方向にオートフィルし、同じ名前が交差する部分の数式を削除します(または斜め罫線を入れる)。
=SUMPRODUCT(INDEX($B$5:$D$100,,MATCH(H$2,$B$4:$D$4))*INDEX($B$5:$D$100,,MATCH($G3,$B$4:$D$4)))
データ追加した場合は、ピボットテーブルを右クリックから「更新」すれば新規データの組み合わせが表示されます。
ただし、新しい商品を追加した場合は、その商品名が自動追加されませんので、自動的に対応したい場合は商品も関数で表示させることになりますが計算負荷が大きくなるのであまりお勧めできません。
![「excelで購入データから商品の組み合わ」の回答画像1](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/f/1223543_5497eb1283622/M.jpg)
No.5
- 回答日時:
No.4 です。
No.4 のコード中、「For j = 2 To ter2」の次にある「With s1」と、下から 4 行目の「End With」は、消し忘れです。無意味なので、消してください。失礼しました。No.4
- 回答日時:
マクロの力技で計算し、挿入したシートに答えを出す例。
標準モジュールにコピペ。思いのほか手間でしたね。'「購入者番号」が A 列にある場合のコード
'集計する表のあるシートをアクティブにしてから実行
Sub RoundRobinTable()
Dim s1 As Worksheet, s2 As Worksheet
Const ini As Long = 4 '集計する対象範囲(見出しを除く部分)の先頭の行番号
Dim ter1 As Long, ter2 As Long, i As Long, j As Long, k As Long
Set s1 = ActiveSheet
ter1 = Cells(Rows.Count, "a").End(xlUp).Row
Worksheets.Add after:=s1
Set s2 = ActiveSheet
With s1
.Rows(ini).Insert
.Cells(ini, "b").Value = "title"
.Range(.Cells(ini, "b"), .Cells(ter1 + 1, "b")).AdvancedFilter _
Action:=xlFilterCopy, copytorange:=s2.Range("a1"), unique:=True
.Rows(ini).Delete
End With
Range("a1").Clear
ter2 = Cells(Rows.Count, "a").End(xlUp).Row
Range(Range("b1"), Cells(1, ter2)) = WorksheetFunction.Transpose(Range(Range("a2"), Cells(ter2, "a")))
Range(Range("a1"), Cells(ter2, ter2)).Borders.LineStyle = xlContinuous
For i = 1 To ter2
Cells(i, i).Borders(xlDiagonalDown).LineStyle = xlContinuous
Next i
For i = 2 To ter2
For j = 2 To ter2
With s1
If i <> j Then
For k = ini To ter1
If WorksheetFunction.CountIf(s1.Range(s1.Cells(ini, "a"), s1.Cells(k, "a")), s1.Cells(k, "a").Value) < 2 And _
WorksheetFunction.CountIfs(s1.Columns("a"), s1.Cells(k, "a").Value, s1.Columns("b"), s2.Cells(i, "a").Value) Then
s2.Cells(i, j).Value = s2.Cells(i, j).Value + WorksheetFunction.CountIfs( _
s1.Columns("a"), s1.Cells(k, "a").Value, s1.Columns("b"), s2.Cells(1, j).Value)
Else
With s2.Cells(i, j)
If .Value = "" Then .Value = 0
End With
End If
Next k
End If
End With
Next j
Next i
End Sub
No.3
- 回答日時:
>関数、またはピボットテーブル
ではなくなってしまいますが...
久しぶりにまじめにループを回してみました。三歩歩くと自分でも分からなくなるかもしれませんので、ご参考までに。
表1が1番目のシートのA1から置いてあるとして、2番目のシートに分類します。表1は購入者番号でソーティングされているものとします。
ちょっとすっきりしない部分もありますが、動いている様にみえます。
'連想配列
Dim myDic As Object
Sub test()
Dim buf As Variant '元データを入れる配列
Dim buf2() As Variant '購入者番号が同じデータ群を入れる配列
Dim i As Long, j As Long
Dim dicKeys As Variant
Dim myKey As String
'ユニークな種類取り出し
Set myDic = CreateObject("Scripting.Dictionary")
With Sheets(1)
buf = .Range(.Range("A2"), .Range("B" & .Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(buf, 1)
If Not myDic.exists(buf(i, 2)) Then myDic.Add buf(i, 2), myDic.Count + 1
Next i
dicKeys = myDic.keys
'Sheets(2)へ見出し行、列として配置
With Sheets(2)
.Cells.ClearContents
.Range(.Cells(1, 2), .Cells(1, myDic.Count + 1)).Value = dicKeys
.Range(.Cells(2, 1), .Cells(myDic.Count + 1, 1)).Value = Application.Transpose(dicKeys)
End With
j = 1
For i = 1 To UBound(buf, 1)
If j = 1 Then
myKey = buf(i, 1)
ReDim buf2(1 To 1)
buf2(1) = buf(i, 2)
j = j + 1
Else
If buf(i, 1) = myKey Then
ReDim Preserve buf2(1 To j)
buf2(j) = buf(i, 2)
j = j + 1
Else
'分配ルーチンに配列を渡す
If UBound(buf2) > 1 Then distribute buf2
j = 1
myKey = buf(i, 1)
ReDim buf2(1 To 1)
buf2(1) = buf(i, 2)
j = j + 1
End If
End If
Next i
If UBound(buf2) > 1 Then distribute buf2
End Sub
Sub distribute(myArray() As Variant)
Dim i As Long, j As Long
Dim destCell As Range
For i = 1 To UBound(myArray)
For j = 1 To UBound(myArray)
If i <> j Then
With Sheets(2)
Set destCell = .Cells(myDic(myArray(i)) + 1, myDic(myArray(j)) + 1)
destCell.Value = destCell.Value + 1
End With
End If
Next j
Next i
End Sub
No.2
- 回答日時:
>併買を集計する目的にかなうのであれば、【表2】の表を変更いただいても構いません。
【表1】と【表2】を同じシートに作成しました。
併買の組み合わせが3つであり途中集計表の下に図形化しました。
途中集計はE2セルに次の式をセットして右および下へオートフィルでコピーします。
=COUNTIFS($A$2:$A$11,$D2,$B$2:$B$11,E$1)
併買のチェックはCOUNTIFS関数を使いました。
=COUNTIFS(E2:E7,1,F2:F7,1)
=COUNTIFS(F2:F7,1,G2:G7,1)
=COUNTIFS(E2:E7,1,G2:G7,1)
貼付画像で確認してください。
![「excelで購入データから商品の組み合わ」の回答画像2](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/5/1229070_5497eb12b72df/M.jpg)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 会計ソフト・業務用ソフト Excelで売上げデータの中の任意の商品の合計を出したい 3 2023/01/18 18:19
- Amazon Amazonで、前回購入した履歴から全く同じ衣類(Tシャツ)の商品を購入したのですが、前回購入した時 2 2022/07/11 22:48
- Excel(エクセル) グループの最後の行に書式、計算式なども同じ行を追加するマクロを教えてもらえませんか。 7 2022/05/18 10:13
- 一眼レフカメラ マップカメラのネットショッピング 1 2022/12/17 01:35
- その他(資産運用・投資) idecoではなりませんが、企業確定拠出年金に加入しています。 毎月の購入する運用商品を4種類、スイ 2 2023/03/18 09:58
- メルカリ メルカリで購入者が一方的な理由でキャンセルしたがってて困ってます。 商品は発送済みで購入者も受け取っ 11 2023/02/25 14:08
- 統計学 これはどうやって解けば良いですか? 下の観測度数表から、クラメールの連関係数とピアソンの連関係数を求 1 2022/07/08 15:38
- 大学・短大 これはどうやって解けば良いですか? 下の観測度数表から、クラメールの連関係数とピアソンの連関係数を求 1 2022/07/08 15:37
- 大学・短大 消費者問題に関する課題が出たのですが、答えが分かりません。 「 A は、インターネットを利用した通信 3 2023/07/31 22:25
- ZOZOTOWN 楽天に出店しているサプリメント会社が怪しいです 4 2022/06/03 00:10
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルやワードを無料で使え...
-
Microsoft365搭載Windows11PCへ...
-
【スプレドシート】IMPORTRANGE...
-
現在、PC2台でMicrosoft 365 Pe...
-
英数字のみ全角から半角に変換
-
Microsoftにofficeアプリについ...
-
Microsoft Formsの「個人情報や...
-
エクセルで英文字に入れた下線...
-
大学のレポート A4で1枚レポー...
-
excelの画面のグリッド線の消滅。
-
会社におけるOfficeライセンス...
-
エクセルでXLOOKUP関数...
-
office365って抵抗感ないですか?
-
outlookで宛先が異なるメールを...
-
Microsoft365で写真をアルバム...
-
Excel 日付を比較したら、同じ...
-
会社PCのメールが更新されない
-
エクセルの貼り付け「リンクさ...
-
Outlook で宛先が複数の場合の人数
-
Microsoft Edgeの「関心のある...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
英数字のみ全角から半角に変換
-
「生産性ソフトウェア」とは何...
-
会社PCのメールが更新されない
-
【関数】○年○ヶ月と表示された...
-
WEBの記事を印刷する際にA...
-
エクセルでXLOOKUP関数...
-
Microsoft familyに追加されま...
-
会社のOutlookにてメールを予約...
-
Microsoft Formsの「個人情報や...
-
Microsoft365の一部を解約したい
-
マクロ自動コピペ 貼り付ける場...
-
Outlook で宛先が複数の場合の人数
-
outlookのメールが固まってしま...
-
【Excel VBA】PDFを作成して,...
-
大学のレポート A4で1枚レポー...
-
office365って抵抗感ないですか?
-
Microsoftにofficeアプリについ...
-
Excel テーブル内の空白行の削除
-
マイクロソフト 一時使用コード...
おすすめ情報