VBA 連続する名前ごとに集計

VBAで連続する名前ごとに以下の集計リストを作成したいのですが、
VBA初心者なので、どなたかVBAのコードを教えて下さい。　宜しくお願いします。
１)元データ(sheet1)から２)作成データ(sheet2)の集計表を作成。
①いちごorすいかなど、同じ名前も多く存在しますが、連続した名前ごとに、数量を小計したい。
②名前（りんご）は、１回のみもあります。
③先頭の名前（みかん）で、日付（日or5/1）を記入。
④元データのリストは、5/1から5/31まで200行ぐらいあります。

1)エクセル元データ（sheet1)
日付 名前 　　管理No. 数量
日 5/1 みかん E1001 300
日 5/1 みかん E1002 300
月 5/2 みかん E1003 150
月 5/2 りんご E1004 300
月 5/2 いちご E1005 300
月 5/2 いちご E1006 300
月 5/2 いちご E1007 300
火 5/3 いちご 未確定 未定
火 5/3 いちご E1009 残
火 5/3 すいか E1010 300
水 5/4 すいか E1011 300
水 5/4 すいか E1012 250
木 5/5 すいか E1013 残
木 5/5 いちご E1014 300
木 5/5 いちご E1015 300
金 5/6 いちご E1016 100
金 5/6 すいか E1017 300
金 5/6 すいか E1018 300

2）作成データ(sheet2)
日付 名前 　　 数量
日 5/1 みかん 750
月 5/2 りんご 300
月 5/2 いちご 900
火 5/3 すいか 850
木 5/5 いちご 700
金 5/6 すいか 600

No.3 ベストアンサー 回答者： fujillin 回答日時： 2022/05/21 21:59

こんばんは

イマイチ把握できていませんけれど・・・

・元データの日付はA列のみで、名前がB列、数量はD列と仮定
・作成データは、日付、名前、数量がA～C列で、タイトル、書式等は設定済みとします

Sub Sample()
Dim sRng As Range, dRng As Range, tmp
Dim rw As Long, sName As String, sSum As Double

Set dRng = Worksheets("Sheet2").Range("A1:C1")
dRng.Offset(1).Resize(Rows.Count - 1, 3).ClearContents

With Worksheets("Sheet1")
For rw = 2 To .Cells(Rows.Count, 2).End(xlUp).Row + 1
Set sRng = .Cells(rw, 1).Resize(, 2)
tmp = .Cells(rw, 4).Value
If Not IsNumeric(tmp) Then tmp = 0

If sRng(2).Text = sName Then
sSum = sSum + tmp
Else
If dRng.Row > 1 Then dRng(3).Value = sSum
Set dRng = dRng.Offset(1)
dRng.Resize(, 2).Value = sRng.Value
sName = sRng(2).Text
sSum = tmp
End If
Next rw
End With
End Sub

この回答へのお礼

思っているような結果が得られました。たいへんありがとうございます。
vbaのコードがいまいち理解に苦しみますが、来週からの仕事が進みそうです。

お礼日時：2022/05/22 00:37

No.2 回答者： ママチャリ 回答日時： 2022/05/21 21:06

『 2）作成データ(sheet2) 』の内容ですが、雑過ぎませんか？

No.1 回答者： めぐみん_ 回答日時： 2022/05/21 20:05

元データの日付は１列目に　曜日＋日付　でシリアル値を基に書式設定でそのようになっているのでしょうか？