見出し画像

エーアイトブイビーエーデシステムカイハツ20ジカン

Sub CreateSummarySheet()
    Dim wsAllData As Worksheet
    Dim wsOrderFormat As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim wsNew As Worksheet
    Dim currentSheet As String
    Dim productName As String
    Dim quantity As Variant
    Dim rowOffset As Long
    
    Set wsAllData = ThisWorkbook.Sheets("全データ")
    Set wsOrderFormat = ThisWorkbook.Sheets("フォーマット受注")
    
    ' 全データシートのデータを発送日ごとにまとめる
    lastRow = wsAllData.Cells(wsAllData.Rows.Count, "D").End(xlUp).Row
    For i = 2 To lastRow
        ' 商品名を取得
        productName = wsAllData.Cells(i, "E").Value
        ' 数量を取得
        quantity = wsAllData.Cells(i, "G").Value
        ' 発送日を取得
        currentSheet = Format(wsAllData.Cells(i, "D").Value, "yyyymmdd")
        ' 発送日のシートが存在しない場合は作成
        If Not SheetExists(currentSheet) Then
            Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            wsNew.Name = currentSheet
            ' フォーマットの内容と書式をコピー
            wsOrderFormat.Cells.Copy wsNew.Cells
            ' まとめた発送日をG3セルに入力
            wsNew.Range("G3").Value = wsAllData.Cells(i, "D").Value
            rowOffset = 0 ' 行のオフセットをリセット
        Else
            Set wsNew = ThisWorkbook.Sheets(currentSheet)
        End If
        ' 商品名をフォーマットシートの指定セルに入力
        wsNew.Range("B9").Offset(rowOffset, 0).Value = productName
        ' 数量をフォーマットシートの指定セルに入力
        wsNew.Range("E9").Offset(rowOffset, 0).Value = quantity
        rowOffset = rowOffset + 1 ' 行のオフセットをインクリメント
    Next i
End Sub

Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not ws Is Nothing
End Function

とりあえず、これが成果。
よくやった自分、ありがとうGPT。

だが、これは通過点。

此処から先はそんなに難しくないはず。

あとは、空白の行を削除して。

各シート複製して、ちょっと変更して。

完成の予定。

予定は未定。

つづく

この記事が気に入ったらサポートをしてみませんか?