原産国別で商品毎の個数と金額の合計を計算したい。

質問

excel2016にてインボイスを作成しております。
A列に商品名、Ｂ列に（原産国)を入力しておりますが、画像の→先のように原産国別に、商品名毎の個数と金額の合計を計算し、結果を別シート(Sheet2)へ貼り付けようとしております。
ピポットテーブルは小計機能は集計行が入り組んでリストとして見にくいので、使用したくはないです。
ご教授いただけたら幸いです。
ちなみに自分はvbaを少し使用できます。簡素なメソッドやステートメントがあればご教授ください。

回答No.4

imogasi

操作と関数でやってみました。
操作が入っているので、データの変動に対して、一部やり直しが必要という
欠点があるが。
ーー
例データ　A1:D9
商品 原産国 個数 金額
SUNSCREEN CHINA 1 20000
SUNSCREEN JAPAN 2 4000
SUNSCREEN JAPAN 1 5000
SUNSCREEN JAPAN 2 10000
SUNSCREEN JAPAN 1 5000
CAMERA JAPAN 1 100
CAMERA JAPAN 1 100
DOLE INDIA 3 5000
ーーー
E1:D9　の結果です。
結合 分離１ 分離２
SUNSCREEN CHINA SUNSCREEN CHINA
SUNSCREEN JAPAN SUNSCREEN JAPAN
SUNSCREEN JAPAN CAMERA JAPAN
SUNSCREEN JAPAN DOLE INDIA
SUNSCREEN JAPAN
CAMERA JAPAN
CAMERA JAPAN
DOLE INDIA
ーー
式と操作は、
E2の式　=A2 & " " & B2
下方向に式複写
E2:E9について、（操作）データーフィルター重複するレコードは無視する
で、
SUNSCREEN CHINA
SUNSCREEN JAPAN
CAMERA JAPAN
DOLE　INDIA
を、F列に出す。
F列について、データー区切り位置でスペースで区切りを指定し、２列（F,G列に）分離して出す。
F1:G５に
分離１ 分離２
SUNSCREEN CHINA
SUNSCREEN JAPAN
CAMERA JAPAN
DOLE INDIA
ができる。
ーー
最終的な計数算出のための関数。
H2セルの式
=COUNTIFS($A$2:$A$9,F2,$B$2:$B$9,G2)
下方向に式を複写。
G2セルに式
=SUMIFS($D$2:$D$9,$A$2:$A$9,F2,$B$2:$B$9,G2)
下方向に式を複写。
ーー
結果　H1:I5
件数 合計
1 20000
4 24000
2 200
1 5000

回答No.3

HohoPapa

SQLを使うとよりシンプルになります。
よかったら使ってみてください。

Sub SampleX()

　Dim cn As Object
　Dim rs As Object
　Dim SQL As String
　Dim shF As String
　Dim shT As Worksheet

　'DBを定義、設定
　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1"
　cn.Open ThisWorkbook.FullName
　shF = "FROM [Sheet1$A1:Z64000]"　'検索対象シート名と範囲
　Set shT = ThisWorkbook.Sheets("Sheet2") '出力先シートを定義

　'SQL文を組立、実行
　SQL = "SELECT [商品],[原産国]," & vbCrLf
　SQL = SQL & "SUM([個数]) as KTotal,SUM([金額]) as GTotal" & vbCrLf
　SQL = SQL & shF & vbCrLf
　SQL = SQL & "Group by [商品],[原産国]" & vbCrLf
　rs.Open SQL, cn

　'出力先をクリアーして結果セットを出力
　shT.Cells.ClearContents
　shT.Cells(1, 1).Value = "商品"
　shT.Cells(1, 2).Value = "原産国"
　shT.Cells(1, 3).Value = "個数"
　shT.Cells(1, 4).Value = "金額"
　shT.Cells(2, 1).CopyFromRecordset rs

　'後処理
　rs.Close
　Set rs = Nothing
　cn.Close
　Set cn = Nothing

End Sub

お礼

ありがとうございます。
ＳＱＬはまだやったことがないのですが、参考にさせていただきます。

回答No.2

nishi6

Dictionaryオブジェクトを使って計算してみました。結果はSheet2に書いています。
ご参考に。当方、win10、Excel2010です。

Sub Test()
　Dim ws1 As Worksheet　'// ワークシート1
　Dim r As Range　　　　'// セルカウンタ
　Dim col As Long　　　 '// 列カウンタ
　Dim dicKey As String　'// キー
　Dim myDic As Object　 '// ディクショナリー
　Dim work As Variant　 '// ワーク変数

　Set ws1 = Worksheets("Sheet1")
　Set myDic = CreateObject("Scripting.Dictionary")
　myDic(0) = Application.Index(ws1.Range("A1").Resize(, 4), 1, 0)

　For Each r In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
　　　dicKey = r.Value & Chr(2) & r(, 2).Value
　　　If Not myDic.exists(dicKey) Then
　　　　　ReDim work(1 To 4)
　　　　　For col = 1 To 4　　　'// A-D列を配列に格納
　　　　　　　work(col) = r.Offset(0, col - 1).Value
　　　　　Next
　　　　　myDic(dicKey) = work　'// Itemに格納
　　　Else
　　　　　work = myDic(dicKey)
　　　　　work(3) = work(3) + r.Offset(0, 2).Value '// 個数を加算
　　　　　work(4) = work(4) + r.Offset(0, 3).Value '// 金額を加算
　　　　　myDic(dicKey) = work
　　　End If
　Next
　Worksheets("Sheet2").Range("A1").Resize(myDic.Count, 4).Value _
　　　　　　　　　　 = Application.Index(myDic.items, 0, 0)
End Sub

お礼

ありがとうございます。
CreateObject("Scripting.Dictionary")など、私にとっては未体験のvbaですが、
参考にさせていただきます。

回答No.1

kon555

vbaが使用できるなら、私ならシンプルに配列に入れて計算させます。組み合わせ数が固定なら通常の配列でいいですが、変動するなら2次元配列の方がいいですね。
「商品」「原産国」が一致したら「個数」と「金額」に加算。一致しなかったら配列一個追加、という風にすればいいです。
https://www.tipsfound.com/vba/02016

お礼

ありがとうございます。参考にさせていただきます。