エクセルVBAで同じ種類を集計したい

質問

A列からAS列までの大きな表があります。
1行目はタイトルで2行目から約500行くらいまでがデータです。
データはA～X列が文字列でAAからAS列が数値です。

これをP列の文字列を基準として
同一のものを別シートにコピーし、その最終行のAAからAS列に数値の合計を入れたいのです。
300行のデータはP列の文字で分類すると20シート程度になるかと思います。

データは既にP列を基準にソートしてあり、途中空白行はP列にはありません。

なにとぞよろしくご教示お願い申し上げます。

回答No.1

papayuka · ベストアンサー

スマートじゃないけど、こんな感じかな。

Sub Test()
Dim tws As Worksheet, ws As Worksheet
Dim r As Range, ro As Range, LRow As Long
　Set tws = ActiveSheet
　Set r = tws.Range("P2") :Set ro = r.Offset(1, 0)
　Do While r.Value <> ""
　　　Do While r.Value = ro.Value
　　　　 Set ro = ro.Offset(1, 0)
　　　Loop
　　Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　On Error Resume Next
　　ws.Name = r.Value
　　tws.Rows(1).Copy Destination:=ws.Rows(1)
　　tws.Range(r, ro.Offset(-1, 0)).EntireRow.Copy _
　　　　　　　　　　Destination:=ws.Rows(2)
　　LRow = ws.Range("P1").End(xlDown).Row + 1
　　ws.Range("AA" & LRow).Resize(1, 19) = _
　　　　　　　　　　"=SUM(AA2:AA" & LRow - 1 & ")"
　　Set r = ro
　Loop
End Sub

お礼

ありがとうございます。
ばっちりでした。

最後にひとつ教えてください。

tws.Range(r, ro.Offset(-1, 0)).EntireRow.Copy _
Destination:=ws.Rows(2)

これはどういう意味でしょうか？

回答No.2

papayuka

> tws.Range(r, ro.Offset(-1, 0)).EntireRow.Copy _
> Destination:=ws.Rows(2)
>
> これはどういう意味でしょうか？

tws はP列を調べたいシート
r がセルP3 、ループ終了時のroがセルP7だとしたら、P3からの同一データはP6までになります。
ro.Offset(-1,0) は P7 を P6に変える処理です。
そうすると、tws.Range(r, ro.Offset(-1, 0))　は　tws.Range("P3","P6")　と同意になります。
EntireRow はセル範囲を行全体にしてくれます。Rows("3:6") に変換するようなイメージです。
Copy はコピー
Destination はコピーの転送先で、必ず新規シートの2行目になりますので ws.Rows(2) です。

お礼

よくわかりました。
ありがとうございました。