Excel VBA

質問

Excel VBAについて

シート１にはデータが入ってます。
G列に日付、L列に商品名、N列に件数。

シート２には集計結果を入力したいです。
セルB2に、日付が10月1日から15日までで、商品名がAの件数の合計。
セルB3は、日付が10月16日から末日まで、セルB4は、日付が11月1日から15日までと半月毎に集計を半年後の末日まで繰返し、B2の数行下には、商品名Bの集計行を作り、その数行下には商品名Cの集計行を作りたいです。

これまでは関数SUMIFSで集計していましたが、複数店舗分のシートの更新・メンテナンスが大変なので、VBAでの集計を考えいろいろ調べてるのですが、方法が思い付かないので、ご教授ください。

回答No.2

nda23

以下の処理で実現できると思います。

Sub F商品集計()
Dim Pシート　　　　 As Worksheet　　'データ用シート
Dim Pセル集合　　　 As Range　　　　'同セル集合
Dim Pセル個別　　　 As Range　　　　'個別セル
Dim D行　　　　　　 As Long　　　　 '行位置
Dim D列　　　　　　 As Long　　　　 '列位置
Dim D索引　　　　　 As Long　　　　 '汎用索引
Dim S語句　　　　　 As String　　　 '文字列
Dim G配列　　　　　 As Variant　　　'配列用データ
Dim P商品集計　　　 As Object　　　 '連想配列
Dim Gキー配列　　　 As Variant　　　'同キー配列
Dim Gキー個別　　　 As Variant　　　'個別のキー
Dim D開始日　　　　 As Date　　　　 '日付範囲の開始日
Dim D最終日　　　　 As Date　　　　 '日付範囲の終了日
Dim D日付　　　　　 As Date　　　　 '日付用ワーク
Dim D件数　　　　　 As Long　　　　 '件数用ワーク
Dim S商品名　　　　 As String　　　 '商品名
Dim D件数配列(11)　 As Long　　　　 '初期配列
'■開始日、最終日の設定
D開始日 = #10/1/2023#　 '←開始日は適宜設定する
D最終日 = DateAdd("m", 6, D開始日) - 1
'■連想配列の初期化
Set P商品集計 = CreateObject("Scripting.Dictionary")
'■シートの設定
Set Pシート = ThisWorkbook.Sheets("シート1")
Set Pセル集合 = Pシート.Cells
'■集計開始
D行 = 1 '1行目からでなければ適宜変更する
Do
　　'■日付を取得する
　　Set Pセル個別 = Pセル集合(D行, 7) 'G列
　　S語句 = Pセル個別.Value
　　Set Pセル個別 = Nothing
　　'■空欄なら集計を終了する
　　If S語句 = "" Then Exit Do
　　'■制御ブロック
　　Do
　　　　'■日付が間違っていれば対象外にする。
　　　　If Not IsDate(S語句) Then Exit Do
　　　　'■日付が範囲外なら対象外にする
　　　　D日付 = CDate(S語句)
　　　　If D日付 < D開始日 Then Exit Do
　　　　If D日付 > D最終日 Then Exit Do
　　　　'■商品名を取得する
　　　　Set Pセル個別 = Pセル集合(D行, 12) 'L列
　　　　S商品名 = Trim(Pセル個別.Value)
　　　　Set Pセル個別 = Nothing
　　　　'■商品名が空欄なら対象外にする
　　　　If S商品名 = "" Then Exit Do
　　　　'■件数を取得する
　　　　Set Pセル個別 = Pセル集合(D行, 14) 'N列
　　　　S語句 = Pセル個別.Value
　　　　Set Pセル個別 = Nothing
　　　　'■件数を数値化する
　　　　D件数 = Val(S語句)
　　　　'■連想配列に商品名が存在するか調べる
　　　　If P商品集計.Exists(S商品名) Then
　　　　　　'■存在すれば既存配列を取得する
　　　　　　G配列 = P商品集計(S商品名)
　　　　Else
　　　　　　'■存在しなければ追加する
　　　　　　G配列 = D件数配列
　　　　　　P商品集計.Add S商品名, G配列
　　　　End If
　　　　'■日付から索引を計算する
　　　　D索引 = (Year(D日付) - Year(D開始日)) * 12
　　　　D索引 = D索引 + (Month(D日付) - Month(D開始日)) * 2
　　　　If Day(D日付) > 16 Then D索引 = D索引 + 1
　　　　'■件数を加算する
　　　　G配列(D索引) = D件数
　　　　'■連想配列に記録する
　　　　P商品集計(S商品名) = G配列
　　Loop While False　　'←ループしない
　　'■行を更新する
　　D行 = D行 + 1
Loop
'■オブジェクトの解放
Set Pセル集合 = Nothing
Set Pシート = Nothing
'■集計結果の表示
Set Pシート = ThisWorkbook.Sheets("シート2")
Set Pセル集合 = Pシート.Cells
'■集計シートの初期化(下記の何れか一方を使う)
Pセル集合.Delete　　　　'←全セルが初期化される
Pセル集合.ClearComments '←文字列だけ消去される
'■配列を操作する
D行 = 2
Gキー配列 = P商品集計.Keys
For Each Gキー個別 In Gキー配列
　　'■A列に商品名を表示する
　　Set Pセル個別 = Pセル集合(D行, 1)
　　Pセル個別.Value = S語句
　　Set Pセル個別 = Nothing
　　'■配列を取り出す
　　G配列 = P商品集計(Gキー個別)
　　'■件数を表示する
　　D列 = 2
　　For D索引 = 0 To 11
　　　　'■件数を表示する
　　　　Set Pセル個別 = Pセル集合(D行, D列)
　　　　Pセル個別.Value = G配列(D索引)
　　　　Set Pセル個別 = Nothing
　　　　'■列を更新する
　　　　D列 = D列 + 1
　　Next
　　'■行を更新する
　　D行 = D行 + 1
Next
'■後処理
Set Pセル集合 = Nothing
Set Pシート = Nothing
Set P商品集計 = Nothing
End Sub

値の取得は以下のコードですが、別法もあります。
【サンプルの例】
Set Pセル個別 = Pセル集合.Cells(D行, 7) 'G列
S語句 = Pセル個別.Value
Set Pセル個別 = Nothing
【別法】
S語句 = Pシート.Cells(D行, 7)

ネイティブコードでオブジェクトを操作する時のクセで、
いちいち Set xx = Nothing としていますが、VBAには
ガベジコレクタがあるので、省略することができます。

回答No.1

AIエージェント あい（@OKWAVE-AI）

まず、以下の手順でExcel VBAでの集計処理を実装することができます。

1. マクロを実行するエディタを開きます。
2. シート２のB2セルから半年後の末日までの集計を繰り返すためのループを作成します。
3. ループ内で、シート１のデータを走査し、条件に合致するデータを集計します。
4. 集計結果をシート２に出力します。

以下に、サンプルコードを記載します。参考にしてください。

```vba
Sub AggregateData()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim itemName As String

Set ws1 = Worksheets("シート１")
Set ws2 = Worksheets("シート２")

' 集計期間の開始日と終了日を設定
startDate = DateSerial(Year(Date), Month(Date), 1)
endDate = DateSerial(Year(Date), Month(Date), WorksheetFunction.EoMonth(Date, 6))

' セルB2から半年後の末日までの集計を繰り返す
For currentDate = startDate To endDate Step 1
' 集計対象の商品名を設定
itemName = "A"

' セルB2に集計結果を出力
ws2.Range("B2").Value = GetTotalQuantity(ws1, currentDate, itemName)

' 商品名Bの集計行を作成
ws2.Range("B2").Offset(1).EntireRow.Insert
ws2.Range("B2").Offset(1).Value = GetTotalQuantity(ws1, currentDate, "B")

' 商品名Cの集計行を作成
ws2.Range("B2").Offset(2).EntireRow.Insert
ws2.Range("B2").Offset(2).Value = GetTotalQuantity(ws1, currentDate, "C")

' 次の集計日を設定
currentDate = WorksheetFunction.EoMonth(currentDate, 0)
Next currentDate
End Sub

Function GetTotalQuantity(ws As Worksheet, dateValue As Date, itemName As String) As Integer
Dim totalQuantity As Integer
Dim lastRow As Long
Dim rng As Range
Dim cell As Range

lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row

Set rng = ws.Range("G2:G" & lastRow)

For Each cell In rng
If cell.Value = dateValue And cell.Offset(0, 5).Value = itemName Then
totalQuantity = totalQuantity + cell.Offset(0, 7).Value
End If
Next cell

GetTotalQuantity = totalQuantity
End Function
```

このコードは、シート１のデータをシート２に集計し、セルB2から半年後の末日までの集計を繰り返します。集計期間毎に商品名A、B、Cの集計行を作成し、それぞれの合計値を出力します。

なお、集計対象の商品名やシート名が異なる場合は、適宜修正してください。

以上のコードを実行することで、VBAによる集計処理を実現できます。お試しください。

------
こちらの回答はAIエージェント「あい」による自動投稿です。
OKWAVEのAIに対する取り組みについてはこちらをご確認ください。
https://staffblog.okwave.jp/2023/06/07/10415/