VBAでの作表について

質問

現在sheet2に商品データが入っています。
商品コード　商品名　個数・・・・
A-1　　　　商品A　　23
A-2　　　　商品B　　45
A-3　　　　商品C　　90
A-2　　　　商品B　　16
これをsheet1に
A-1　　　　商品A　　23
A-2　　　　商品B　　61
A-3　　　　商品C　　90
のように重複はまとめて作表するにはコードはどうすればよいのでしょうか？
そして最終行に合計の欄も設けたいのですが是非皆様のお力を貸してください。

回答No.6

imogasi

なぜVBAに拘るのかな。
今までは関数でという質問が多かった。
重複のない氏名のリストを出すのがむつかしいだけ。
後はSUMIFの方が簡単。
ーー
フィルタオプションの利用で説明する。
例データ
Sheet2を対象に
氏名
氏名 計数
山田 1
家田 2
木村 3
海野 4
山田 5
山田 6
木下 7
木村 8
本村 9
とし、Sheet2のA1:A１０を名前と範囲名をつける。
異なるシート間でフィルタオプションを使うための対策）
ーー
Sheet1に行って
A1:A2に
氏名
山田
と入れて
Sheet1を開いた状態で
データーフィルターフィルタオプションの設定
指定した範囲　にチェック
リスト範囲　=氏名
検索条件範囲　何も入れず
抽出範囲　　A1:A10
重複するレコードは無視する
OK
結果
氏名
山田
家田
木村
海野
木下
本村
となる。それを使ってSUMIFで集計する。
結果
氏名 計数
山田 12
家田 2
木村 11
海野 4
木下 7
本村 9
B2セルの式は
=SUMIF(Sheet2!$A$2:$A$10,A2,Sheet2!$B$2:$B$10)
これを下方向に式を複写する。
これをマクロの記録でもとってマクロ化はできる。

回答No.5

fumufumu_2006

こんな方法はどうでしょうか？
手動をマクロで保存して、書き換えてみました。
データが多いと重いかもしれませんが・・・

Sheet2のA列とB列のデータ範囲を選んで、データ->フィルタ->フィルタオプションの設定->抽出範囲はSheet1のA1からで、重複するレコードは無視する
Sheet1のデータを並べ替え
1行目の集計計算式設定（配列数式）
2行目以降にコピー

Sub test()
Dim rows1 As Long
Dim rows2 As Long
Sheet1.Cells.Clear
rows2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).row
Sheet2.Range("A1:B" & rows2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range("A1"), Unique:=True
rows1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).row
Sheet1.Range("A1:B" & rows1).Sort Key1:=Sheet1.Range("A1"), Header:=xlNo
Sheet1.Range("C1").FormulaArray = "=SUM(IF(Sheet2!A1:A" & rows2 & "=A1,Sheet2!G1:G" & rows2 & "))"
Sheet1.Range("D1").FormulaArray = "=SUM(IF(Sheet2!A1:A" & rows2 & "=A1,Sheet2!M1:M" & rows2 & "))"
Sheet1.Range("E1").FormulaArray = "=SUM(IF(Sheet2!A1:A" & rows2 & "=A1,Sheet2!N1:N" & rows2 & "))"
Sheet1.Range("F1").FormulaArray = "=SUM(IF(Sheet2!A1:A" & rows2 & "=A1,Sheet2!O1:O" & rows2 & "))"
Sheet1.Range("C1:F1").Copy Destination:=Sheet1.Range("C2:F" & rows1)
End Sub

回答No.4

toshio_kun

「この回答への補足」の追加内容のイメージがわかりかねますので、各列に何が入っているのか補足説明願います。

補足

G列には個数。つまり在庫数です。
Ｍには在庫単価が
Ｎには運賃
Ｏには在庫金額が入っています。
・・・・どうでしょうか？

回答No.3

n-jun

＞商品コード　商品名　個数・・・・
・・・とは列はどの位ありますか？（固定or変動）

回答No.2

squip

Aをキーとしてソート、そして集計、表示レベル指定。
以上の操作をマクロ記録して修正。

Sheet2のコード
Sub do_it()
　　With Cells(1)
　　　　.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
　　　　　　OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
　　　　.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
　　　　　　Replace:=True, PageBreaks:=False, SummaryBelowData:=True
　　　　.Parent.Outline.ShowLevels RowLevels:=2
　　End With
End Sub

回答No.1

toshio_kun

単純なパターンで書いておきます。
sheet2にコマンドボタンを配置して「CommandButton1_Click」イベントに設定しています。
-----------以下--------------------
Dim dlines(1000, 3) As String
Dim head(3) As String
Dim lsize As Integer

Public Sub addLine(cell As Range)
Dim val As Integer
Dim counter As Integer
If (lsize > 0) Then
For counter = 0 To lsize - 1
If (StrComp(cell.Value, dlines(counter, 0)) = 0) Then
val = CInt(dlines(counter, 2)) + cell.Offset(0, 2).Value
dlines(counter, 2) = CStr(val)
Exit Sub
End If
Next
End If
dlines(lsize, 0) = cell.Value
dlines(lsize, 1) = cell.Offset(0, 1).Value
dlines(lsize, 2) = CStr(cell.Offset(0, 2).Value)
lsize = lsize + 1
End Sub
Public Sub putSheet()
Dim counter As Integer
Dim val As Integer
Dim total As Integer
total = 0
With ThisWorkbook.Worksheets("sheet1").Range("A2")
For counter = 0 To lsize - 1
val = CInt(dlines(counter, 2))
.Offset(counter, 0).Value = dlines(counter, 0)
.Offset(counter, 1).Value = dlines(counter, 1)
.Offset(counter, 2).Value = val
total = total + val
Next
.Offset(lsize, 0).Value = "計"
.Offset(lsize, 2).Value = total
End With
End Sub
Public Sub putTitle()
With ThisWorkbook.Worksheets("sheet2").Range("A1")
head(0) = .Offset(0, 0).Value
head(1) = .Offset(0, 1).Value
head(2) = .Offset(0, 2).Value
End With
With ThisWorkbook.Worksheets("sheet1").Range("A1")
.Offset(0, 0).Value = head(0)
.Offset(0, 1).Value = head(1)
.Offset(0, 2).Value = head(2)
End With
End Sub

Private Sub CommandButton1_Click()
Dim codeRange As Range
lsize = 0
Call putTitle
For Each codeRange In ThisWorkbook.Worksheets("sheet2").Range("A2:A1001")
If (IsNull(codeRange.Value) = False) Then
If (IsEmpty(codeRange.Value) = False) Then
Call addLine(codeRange)
Else
Exit For
End If
Else
Exit For
End If
Next
Call putSheet
End Sub

補足

ものすごく早い対応ありがとうございます。
追加で申し訳ないのですが
sheet2のC列ではなくsheet2のG列をsheet1のC列へ
sheet2のM列をsheet1のD列へ
sheet2のN列をsheet1のE列へ
sheet2のO列をsheet1のF列へ
集計するんですが合わせて教えていただけないでしょうか？
何度も申し訳ございません。
ぜひともよろしくお願いいたします。