売上管理シートの作成

Question

売上管理シート作成

現在売上管理シートをを作成していて、連番と重複を１行にまとめるコードをを調べながら書いてる途中です。
下記の項目機能を作成したいのですが、全くわからないので下記の項目が動くコード教えてもらえると幸いです。

・「No」は1からの連番を振り、1回の会計で1つのNoとする
・1商品毎1行で表記する（同一会計内において、「No」と「販売日時」は垂直方向でセル結合をする）
・「販売日時」は「会計」ボタンをを押した時点の日時とし、「YYYY/MM/DD hh:mm」の形式とする
・価格を表示する部分は「￥9,999（￥は半角文字）」の形式とし、数字は整数表記とする
・「販売額」は [単価×販売数]で計算する

会計ボタンを押すと、明細シートのA1セル「商品コード」B1セル「商品名」C1セル「単価」の下に情報が記入された後に、売上管理シートに「No」「販売日時」「商品コード」「商品名」「単価」「販売数」「販売額」データを反映したいです。

削除ボタンがあるので、会計ボタンを押した後は明細シートの情報を消します。

会計ボタンを押した後の明細シート↓

現在の売上管理シート↓

売上管理シート完成見本↓

会計ボタン

'会計
Sub Total()
'売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
    Dim lngNo As Long
    Dim strNitiji As String
    strNitiji = Format(Now, "YYYY/MM/DD hh:mm")
    Dim lngEndRow: lngEndRow = Worksheets("売上管理").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Arow As Long
    Dim i As Long, j As Long, k As Long
    k = 0
    Dim myDic As Object
    Dim mykeys, myItems
    Dim varArrayItems As Variant
    Dim ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku
    'Setステートメントで戻り値をオブジェクト変数に代入する
    Set myDic = CreateObject("Scripting.Dictionary")

    'A列でリストの最終行を調べる
    Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row

        With Worksheets("明細")
            For i = 2 To Arow
                ProductCode = .Cells(i, 1).Value
                If myDic.Exists(ProductCode) = False Then
                    ProductName = .Cells(i, 2).Value
                    Tanka = .Cells(i, 3).Value
                    Hanbaisuu = Application.WorksheetFunction.CountIf(.Range("B:B"), .Cells(i, 2).Value)
                    Hanbaigaku = Tanka * Hanbaisuu
                    varArrayItems = Array(ProductName, Tanka, Hanbaisuu, Hanbaigaku)
                    myDic.Add ProductCode, varArrayItems
               End If
            Next
        End With
        With Worksheets("売上管理")
            .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
            For j = 0 To myDic.Count - 1
               mykeys = myDic.Keys
               myItems = myDic.Items
               '販売日時、商品コード、商品名、単価、販売数、販売額を表示する
               .Range("A" & j + 2).Value = lngNo + 1
               .Range("B" & j + 2).Value = strNitiji
               .Range("C" & j + 2).Value = mykeys(j)
               .Range("D" & j + 2).Value = myItems(j)(k)
               .Range("E" & j + 2).Value = myItems(j)(k + 1)
               .Range("F" & j + 2).Value = myItems(j)(k + 2)
               .Range("G" & j + 2).Value = myItems(j)(k + 3)
               k = 0
            Next j
        End With
  
        'Dictionaryを初期化
        myDic.RemoveAll

End Sub

補足情報（FW/ツールのバージョンなど）

office365Excell

Comments

[meg_]

> 現在売上管理シートを調べながら作成してるのですが、わからないので教えてもらえると幸いです。
何を「教えてもら」いたいのでしょうか？
どこまで出来ていてどこで困っているのでしょう？

[arin]

申し訳ございません。
説明文の追加編集しましたので確認よろしくお願いします。

Answer 1

修正して再掲。

Sub total()
     '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
    Dim k
    Dim lngNo As Long
    Dim strNitiji As String
    Dim varKodoNamePrice As Variant
    strNitiji = Format(Now, "YYYY/MM/DD hh:mm")
    Dim lngEndRow: lngEndRow = Worksheets("売上管理").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Arow As Long
    Dim i As Long, j As Long
    Dim myDic As Object
    Dim mykeys, myItems
    Dim varArrayItems As Variant
    Dim ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku
    Set myDic = CreateObject("Scripting.Dictionary")

    'A列でリストの最終行を調べる
    Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row

    With Worksheets("明細")
        For i = 2 To Arow
            ProductCode = .Cells(i, 1).Value
            If Not myDic.Exists(ProductCode) Then
                ProductName = .Cells(i, 2).Value
                Tanka = .Cells(i, 3).Value
                Hanbaisuu = WorksheetFunction.CountIf(.Columns(1), ProductCode)
                Hanbaigaku = Tanka * Hanbaisuu
                varKodoNamePrice = Array(ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku)
                '連想配列、キーとデータを追加する
                myDic.Add ProductCode, varKodoNamePrice
            End If
        Next i
    End With

    With Worksheets("売上管理")
        myItems = myDic.Items
        For j = 0 To myDic.Count - 1
            'キーとデータをセルに表示する
            .Cells(lngEndRow, 1).Offset(1 + j, 2).Resize(, 5).Value = myItems(j)
        Next j
        
        lngNo = WorksheetFunction.Max(.Columns(1)) + 1
        .Cells(lngEndRow, 1).Offset(1).Resize(, 2).Value = Array(lngNo, strNitiji)
        .Cells(lngEndRow, 1).Offset(1).Resize(myDic.Count).Merge
        .Cells(lngEndRow, 2).Offset(1).Resize(myDic.Count).Merge
    End With
End Sub

---

＜追記＞　整理整頓。

Sub total()
    
    'シートの準備
    With ThisWorkbook
        Dim meisai As Worksheet
        Dim urikan As Worksheet
        Set meisai = .Worksheets("明細")
        Set urikan = .Worksheets("売上管理")
    End With
    
    '明細を取得し集計
    With meisai
        '連想配列（重複除去用）の準備
        Dim myDic As Object
        Set myDic = CreateObject("Scripting.Dictionary")
        
        '明細データの格納
        Dim ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku
        Dim varKodoNamePrice As Variant
        Dim i
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            ProductCode = .Cells(i, 1).Value
            If Not myDic.Exists(ProductCode) Then
                ProductName = .Cells(i, 2).Value
                Tanka = .Cells(i, 3).Value
                Hanbaisuu = WorksheetFunction.CountIf(.Columns(1), ProductCode)
                Hanbaigaku = Tanka * Hanbaisuu
                varKodoNamePrice = Array(ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku)
                myDic.Add ProductCode, varKodoNamePrice
            End If
        Next i
        
        '出力用配列の準備
        Dim myItems As Variant, myCount As Long
        myItems = WorksheetFunction.Transpose(WorksheetFunction.Transpose(myDic.Items))
        myCount = myDic.Count
    End With
     
    
    '売上管理に出力
    With urikan
        '開始行の決定
        Dim lngNewRow As Long
        lngNewRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
        
        '連番、日付の決定
        Dim lngNo As Long, strNow As String
        lngNo = WorksheetFunction.Max(.Columns(1)) + 1
        strNow = Format(Now, "YYYY/MM/DD hh:mm")
        
        '連番、日付の出力、セル結合
        .Cells(lngNewRow, 1).Resize(, 2).Value = Array(lngNo, strNow)
        .Cells(lngNewRow, 1).Resize(myCount).Merge
        .Cells(lngNewRow, 2).Resize(myCount).Merge

        '明細の出力
        .Cells(lngNewRow, 3).Resize(myCount, 5).Value = myItems
    End With

End Sub

Comments

[arin]

jinojiさん回答ありがとうございます。
教えてもらったコードを組み込み考えると、現在のコードのIf文は必要ないようになりますね。
元コードのどこが気になったのですか？

[jinoji]

On Error Resume Next のせいでエラーにならないだけで
RangeItems あたりの処理が正しく書けてないと思います。
キー重複の時のエラーを回避するなら、
たとえば If Not myDic.Exists(xx) Then のような If文を入れることで実現できます。
安易にOn Error Resume Nextを使わない方がいいです。

もう一つ、jのForループは i のForループの中でなく i を回し終わった後にする方が適切だと思います。
こちらは同じことを繰り返して無駄になるだけで結果は変わらないはずなので
実害はないと思いますが。

[arin]

すみません。
今更ながら.Existsを知り書いておりました。
下記のように組み替えてい最初のIf文でエラーが「オブジェクト変数または With ブロック変数が設定されていません。」と出てきたのですが何処のSetが抜けているのですか？

```
'売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
Dim lngNo As Long
Dim strNitiji As String
Dim varKodoNamePrice As Variant
strNitiji = Format(Now, "YYYY/MM/DD hh:mm")
Dim lngEndRow: lngEndRow = Worksheets("売上管理").Cells(Rows.Count, 1).End(xlUp).Row
Dim Arow As Long
Dim i As Long, j As Long
Dim myDic As Object
Dim mykeys, myItems
Dim varArrayItems As Variant
'A列でリストの最終行を調べる
Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row

With Worksheets("明細")
Dim c, n, t, s, g, arr
For i = 2 To Arow
Set c = .Cells(i, 1).Value
If Not myDic.Exists(c) Then
n = .Cells(i, 2).Value
t = .Cells(i, 3).Value
s = WorksheetFunction.CountIf(.Columns(1), c)
g = t * s
arr = Array(c, n, t, s, g)
'連想配列、キーとデータを追加する
myDic.Add c, arr
End If
Next i
End With

With Worksheets("売上管理")
lngNo = WorksheetFunction.Max(.Columns(1)) + 1
.Cells(lngEndRow, 1).Offset(1).Value = lngNo
.Cells(lngEndRow, 1).Offset(1).Resize(myDic.Count).Merge
.Cells(lngEndRow, 2).Offset(1).Resize(myDic.Count).Merge
myItems = myDic.Items
For j = 0 To myDic.Count - 1
'キーとデータをセルに表示する
.Range("C" & j + 2).Resize(, 5).Value = myItems(j)
Next j
End With
```

[jinoji]

Set c = .Cells(i, 1).Value だと文法上おかしくて、
c = .Cells(i, 1).Value か Set c = .Cells(i, 1) のどちらか。

[arin]

本当にすみません。
どちらでも同じ文言のエラーおきますね

[jinoji]

Set myDic = CreateObject("Scripting.Dictionary")をしてないから

[arin]

Noが一番から出来ないのと一度コードで登録すると、削除ボタンで明細シートを初期化時に再度売上管理に登録出来ないのですが、Keyを初期すれば良いのですか？

[jinoji]

lngNo の処理がない
If myDic.Exists(ProductCode) = False Then の場所がおかしい

[arin]

回答にあるコードでその結果です。
Noが一番から出来ないのと一度コードで登録すると、削除ボタンで明細シートを初期化時に再度売上管理に登録出来ないのです。

[jinoji]

Noが一番から出来ないとは具体的にどうなるのですか（そしてどうなってほしいのですか）

[arin]

連番が1番からではなく2番からになっているので、1番から連番が振れるようにしたいのと、一度コードでDictionaryに登録すると、削除ボタンで明細シートを初期化時に再度同じ売上管理に登録出来ないのですが、Keyを初期すれば良いのですか？

[arin]

再掲ありがとうございます！
現状の売上管理の連番が1番からではなく2番からになっている現象がIf文で解決出来ました。
jinojiさん本当にありがとうございます。