質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.36%

売上管理シートの作成

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 214

score 5

売上管理シート作成

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

・「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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • meg_

    2021/11/25 19:55

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

    キャンセル

  • arin

    2021/11/25 20:23

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

    キャンセル

回答 1

checkベストアンサー

0

修正して再掲。

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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2021/11/30 10:36 編集

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

    キャンセル

  • 2021/11/30 11:04

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

    キャンセル

  • 2021/11/30 15:16 編集

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.36%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る