Excel VBA 集計方法

質問

1つのファイルに2つのシートがあります。
集計結果を反映するシートと元データのシートで別れています。

<元データシート>
品番 品名 　　　バージョン　 数量
11 ABC Soft 　　　　　2000 4
22 XYS Beta 2003 3
23 HU22 hyoukaban 2000 4
45 298 Software 1998 7
22 XYS Beta 2003 11
25 XYS Beta 2008 3
27 XYS Beta 2008 6

<集計結果シート>
品名 バージョン 数量
XYS Beta 2008 3
XYS Beta 2003 14
298 Software 1998 7
ABC Soft 2000 4
HU22 hyoukaban 2000 4

※表がずれていると思います。
バージョンは4桁の数字です。

マクロを実行して、自動的に元データの情報を集計して
集計結果シートに反映したいと思います。
(1)同じ品名ごとに並べて、同じ品名が見つかった場合はバージョンの新しいものが上になるようにしたいです。
(2)品番は集計結果シートには反映していません。
(3)同じ品名、バージョンで異なる品番がございます。
同じ品名、バージョンであれば品番が異なっても1つに集計することは可能でしょうか。
→(3)だけが理解できていません。(1)と(2)は解決済みです。

回答No.4

ka_na_de · ベストアンサー

こんにちは。

＞For i = 1 To myLastRow
＞　　.Cells(i, "A").Value = .Cells(i, "B").Value & .Cells(i, "C").Value
＞Next i
＞B列「品名」かつC列「バージョン」が同じA列「品番」が「i」であるという認識でよろしいでしょうか。

ちょっと違います。
前回は品番が一意ということでしたので、A列の品番を比較して、
同じものの数量（D列）を合計していくようにしていました。

しかし、今回の質問では、同じ品名、バージョンで異なる品番がある
ということでしたので、「品名」と「バージョン」を連結した文字列
を新たに作って、それが同じかどうかで比較してます。
　例えば、「XYS Beta」 「2003」を連結して「XYS Beta2003」
　という文字列を作って、これと同じものの数量（D列）を合計します。

＞For i = 1 To myLastRow
＞　　.Cells(i, "A").Value = .Cells(i, "B").Value & .Cells(i, "C").Value
＞Next i

はB列とC列を連結した文字列をA列の値に代入していくという処理を
１行目からデータの最終行まで繰り返すということです
したがって、この時点で、A列の「品番」は「連結文字」に置き換わります。
あとの処理は前回と同様です。

私は、前回の質問で作ったコードをできる限りそのまま利用する形で
作成したかったので、このような冗長的な記述になりました。

もちろん、＃２さんが行っているように
If ws1.Cells(i, 2).Value & ws1.Cells(i, 3).Value = ws2.Cells(j, 1).Value & ws2.Cells(j, 2).Value Then
ws2.Cells(j, 3).Value = ws2.Cells(j, 3).Value + ws1.Cells(i, 4).Value
Exit For
のように、直接「連結文字」を比較しても同じです。
速度的には、＃２さんのやり方のほうが速いと思います。

最後に前回の質問のページのURLを載せておきます。
http://oshiete1.goo.ne.jp/qa5739356.html

お礼

ご回答ありがとうございました。詳細なご説明助かります。よく理解できました。前回のコードを利用して頂いたので、すんなり理解できました。

回答No.3

tom04

こんにちは！
VBAでないので参考にならなかったら無視してください。

↓の画像でSheet1に作業用の列を2列使っています。
Sheet1のE2セルに
=B2&C2
F2セルに
=IF(OR(E2="",COUNTIF($E$2:E2,E2)<>1),"",RANK(C2,$C$2:$C$1000)*1000+ROW(A1))
という数式を入れ、E2・F2セルを範囲指定しF2セルのフィルハンドルで下へずぃ～～～！っとコピーします。

そして、Sheet2のA2セルに
=IF(COUNT(Sheet1!$F$2:$F$1000)<ROW(A1),"",INDEX(Sheet1!B$2:B$1000,MOD(SMALL(Sheet1!$F$2:$F$1000,ROW(A1)),1000)))
とし、隣のB2セルまでコピーします。
C2セルには
=IF(A2="","",SUMIF(Sheet1!$E$2:$E$1000,A2&B2,Sheet1!$D$2:$D$1000))
という数式を入れ、A2～C2セルを範囲指定し
C2セルのフィルハンドルで下へコピーすると
画像のような感じになります。
尚、数式はSheet1の1000行目まで対応できるようにしています。

以上、参考になれば良いのですが
最初に書いたように的外れなら読み流してくださいね。m(__)m

お礼

ご回答ありがとうございました。画像までつけていただきイメージができわかりやすいです。VBA以外の解決方法についても勉強したいと思います。

回答No.2

hige_082

回答出てますね
折角作ったので・・・

Sub test()
Dim i, j
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("元データ")
Set ws2 = Worksheets("集計結果")

For i = 2 To ws1.Cells(Rows.Count, 2).End(xlUp).Row
For j = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 2).Value & ws1.Cells(i, 3).Value = ws2.Cells(j, 1).Value & ws2.Cells(j, 2).Value Then
ws2.Cells(j, 3).Value = ws2.Cells(j, 3).Value + ws1.Cells(i, 4).Value
Exit For
End If
Next j
If ws2.Cells(Rows.Count, 2).End(xlUp).Row < j Then
ws1.Cells(i, 2).Resize(1, 3).Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next i
End Sub

参考まで

お礼

ご回答ありがとうございました。いろんな方のマクロを見ることで勉強になります。頂きました内容を本やWebで調べて勉強します。

回答No.1

ka_na_de

こんばんは。

前回の回答に３行加えました。

Sub test4()
　　Dim Ws1 As Worksheet
　　Dim Ws2 As Worksheet
　　Dim Ws3 As Worksheet
　　Dim mySt As Worksheet
　　Dim myLastRow As Long
　　Dim i As Long
　　Dim myStName As String
　　Dim flg As Boolean

　　Application.ScreenUpdating = False

　　Set Ws1 = Worksheets("元データ")
　　Set Ws2 = Worksheets("集計結果")

　　myStName = "作業シート"
　　For Each mySt In Worksheets
　　　　If mySt.Name = myStName Then flg = True
　　Next mySt
　　If flg = False Then
　　　　ActiveWorkbook.Worksheets.Add.Name = myStName
　　Else
　　　　Worksheets(myStName).Cells.Clear
　　End If
　　Set Ws3 = Worksheets(myStName)

　　With Ws3
　　　　Ws1.Range("A1").CurrentRegion.Copy Destination:=.Range("A1")

　　　　.Range("A1").CurrentRegion.Sort _
　　　　　　　　Key1:=.Range("B2"), Order1:=xlAscending, _
　　　　　　　　Key2:=.Range("C2"), Order2:=xlDescending

　　　　myLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

　　　　For i = 1 To myLastRow
　　　　　　.Cells(i, "A").Value = .Cells(i, "B").Value & .Cells(i, "C").Value
　　　　Next i

　　　　For i = myLastRow To 2 Step -1
　　　　　　If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
　　　　　　　　 .Cells(i - 1, "D").Value = .Cells(i - 1, "D").Value _
　　　　　　　　　　　　　　　　　　　　　　+ .Cells(i, "D").Value
　　　　　　　　.Rows(i).Delete
　　　　　　End If
　　　　Next i

　　　　.Columns(1).Delete
　　　　.Range("A1").CurrentRegion.Copy Destination:=Ws2.Range("A2")
　　　　Application.DisplayAlerts = False
　　　　.Delete
　　　　Application.DisplayAlerts = True
　　End With

　　Application.ScreenUpdating = True

　　Set Ws1 = Nothing
　　Set Ws2 = Nothing
　　Set Ws3 = Nothing
End Sub

補足

ご回答ありがとうございました。
追加して頂きました3行で問題なく実行できました。
この3行について、教えてください。

For i = 1 To myLastRow
　　.Cells(i, "A").Value = .Cells(i, "B").Value & .Cells(i, "C").Value
Next i

B列「品名」かつC列「バージョン」が同じA列「品番」が「i」であるという認識でよろしいでしょうか。

よろしくお願いいたします。