編集履歴

質問編集履歴

画像の追加

2021/11/30 06:15

投稿

arin

スコア5

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -32,7 +32,7 @@
 現在の売上管理シート↓
-![イメージ説明](f8648490b3414b426d5e27d0c3d128f4.png)
+![イメージ説明](3673ca0a834b8eaecbc0eebb82cede84.png)
 売上管理シート完成見本↓

コード修正

2021/11/30 06:15

投稿

arin

スコア5

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -54,15 +54,11 @@
 Sub Total()
-     '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
+'売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
-    Dim k
     Dim lngNo As Long
     Dim strNitiji As String
-    Dim varKodoNamePrice As Variant
     strNitiji = Format(Now, "YYYY/MM/DD hh:mm")
@@ -70,7 +66,9 @@
     Dim Arow As Long
-    Dim i As Long, j As Long
+    Dim i As Long, j As Long, k As Long
+    k = 0
     Dim myDic As Object
@@ -92,15 +90,13 @@
-        If myDic.Exists(ProductCode) = False Then
+        With Worksheets("明細")
             For i = 2 To Arow
-                With Worksheets("明細")
+                ProductCode = .Cells(i, 1).Value
-                    ProductCode = .Cells(i, 1).Value
+                If myDic.Exists(ProductCode) = False Then
                     ProductName = .Cells(i, 2).Value
@@ -114,39 +110,49 @@
                     myDic.Add ProductCode, varArrayItems
-                End With
+               End If
             Next
-            With Worksheets("売上管理")
+        End With
-                .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
+        With Worksheets("売上管理")
-                 For j = 0 To myDic.Count - 1
+            .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
-                    mykeys = myDic.Keys
+            For j = 0 To myDic.Count - 1
-                    myItems = myDic.Items
+               mykeys = myDic.Keys
-                    'キーとデータをセルに表示する
+               myItems = myDic.Items
-                    .Range("C" & j + 2).Value = mykeys(j)
+               '販売日時、商品コード、商品名、単価、販売数、販売額を表示する
-                    .Range("D" & j + 2).Value = myItems(j)(j)
+               .Range("A" & j + 2).Value = lngNo + 1
-                    .Range("E" & j + 2).Value = myItems(j)(j + 1)
+               .Range("B" & j + 2).Value = strNitiji
-                    .Range("F" & j + 2).Value = myItems(j)(j + 2)
+               .Range("C" & j + 2).Value = mykeys(j)
-                    .Range("G" & j + 2).Value = myItems(j)(j + 3)
+               .Range("D" & j + 2).Value = myItems(j)(k)
-                 Next j
+               .Range("E" & j + 2).Value = myItems(j)(k + 1)
-            End With
+               .Range("F" & j + 2).Value = myItems(j)(k + 2)
+               .Range("G" & j + 2).Value = myItems(j)(k + 3)
+               k = 0
+            Next j
-        End If
+        End With
+        'Dictionaryを初期化
+        myDic.RemoveAll

文変更

2021/11/30 05:24

投稿

arin

スコア5

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -54,7 +54,7 @@
 Sub Total()
-    '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
+     '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
     Dim k
@@ -76,141 +76,79 @@
     Dim mykeys, myItems
-    Dim RangeItems As Range
+    Dim varArrayItems As Variant
-    For k = 2 To Cells(Rows.Count, 2).End(xlUp).Row
+    Dim ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku
-        With Worksheets("売上管理")
+    'Setステートメントで戻り値をオブジェクト変数に代入する
-            If .Cells(lngEndRow, 1).Value = "No" Then
+    Set myDic = CreateObject("Scripting.Dictionary")
+    'A列でリストの最終行を調べる
+    Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
+        If myDic.Exists(ProductCode) = False Then
+            For i = 2 To Arow
+                With Worksheets("明細")
+                    ProductCode = .Cells(i, 1).Value
+                    ProductName = .Cells(i, 2).Value
-                '.Cells(lngEndRow, 1).Offset(1).Value = 1
+                    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 With
+            Next
+            With Worksheets("売上管理")
                 .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
-                'Setステートメントで戻り値をオブジェクト変数に代入する
+                 For j = 0 To myDic.Count - 1
+                    mykeys = myDic.Keys
+                    myItems = myDic.Items
+                    'キーとデータをセルに表示する
-                Set myDic = CreateObject("Scripting.Dictionary")
+                    .Range("C" & j + 2).Value = mykeys(j)
+                    .Range("D" & j + 2).Value = myItems(j)(j)
+                    .Range("E" & j + 2).Value = myItems(j)(j + 1)
+                    .Range("F" & j + 2).Value = myItems(j)(j + 2)
+                    .Range("G" & j + 2).Value = myItems(j)(j + 3)
+                 Next j
+            End With
-                'A列でリストの最終行を調べる
+        End If
-                Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
-                '連想配列、キー重複の時エラーを無視
-                On Error Resume Next
-                For i = 2 To Arow
-                    RangeItems = Range(Worksheets("明細").Cells(i, 2).Value, Worksheets("明細").Cells(i, 3).Value)
-                    '連想配列、キーとデータを追加する
-                    myDic.Add Worksheets("明細").Cells(i, 1).Value, RangeItems
-                    For j = 0 To myDic.Count - 1
-                        mykeys = myDic.Keys
-                        myItems = myDic.RangeItems
-                        'キーとデータをセルに表示する
-                        .Range("C" & j + 2).Value = mykeys(j)
-                        .Range("D" & j + 2).Value = myItems(i, j)
-                    Next j
-                Next i
-                'オブジェクトを解放する
-                Set myDic = Nothing
-                .Cells(lngEndRow, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.CountIfs(.Range("B:B"), .Cells(k, 2).Value, .Range("C:C"), .Cells(k, 3).Value)
-                '.Cells(lngEndRow, 7).End(xlUp).Offset(1).Value = .Cells(k, 5).Value * .Cells(k, 6).Value
-            Else
-                '.Cells(lngEndRow, 1).Offset(1).Value = .Cells(lngEndRow - 1, 1).Value + 1
-                .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
-                'Setステートメントで戻り値をオブジェクト変数に代入する
-                Set myDic = CreateObject("Scripting.Dictionary")
-                'A列でリストの最終行を調べる
-                Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
-                '連想配列、キー重複の時エラーを無視
-                On Error Resume Next
-                For i = 2 To Arow
-                    RangeItems = Range(Worksheets("明細").Cells(i, 2).Value, Worksheets("明細").Cells(i, 3).Value)
-                    '連想配列、キーとデータを追加する
-                    myDic.Add Worksheets("明細").Cells(i, 1).Value, RangeItems
-                    For j = 0 To myDic.Count - 1
-                        mykeys = myDic.Keys
-                        myItems = myDic.RangeItems
-                        'キーとデータをセルに表示する
-                        .Range("C" & j + 2).Offset.Value = mykeys(j)
-                        .Range("D" & j + 2).Offset.Value = myItems(i, j)
-                    Next j
-                Next i
-                 'オブジェクトを解放する
-                Set myDic = Nothing
-                .Cells(lngEndRow, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.CountIfs(.Range("B:B"), .Cells(k, 2).Value, .Range("C:C"), .Cells(k, 3).Value)
-                '.Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = .Cells(k, 5).Value * .Cells(k, 6).Value
-            End If
-        End With
-    Next
 End Sub

省略化

2021/11/29 09:33

投稿

arin

スコア5

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -54,32 +54,6 @@
 Sub Total()
-    ' --- 各セルのRangeオブジェクトを準備 ---
-    Dim objTotalPriceCell As Range
-    Dim objPaymentPriceCell As Range
-    Dim objChangePriceCell As Range
-    With Worksheets("商品登録")
-        Set objTotalPriceCell = .Range("F10")
-        Set objPaymentPriceCell = .Range("F13")
-        Set objChangePriceCell = .Range("F15")
-    End With
-    'おつりの計算
-    objChangePriceCell = objPaymentPriceCell - objTotalPriceCell
     '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
     Dim k

画像の追加

2021/11/26 10:11

投稿

arin

スコア5

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -30,6 +30,10 @@
 ![明細シート](43f772eff6255cad17503cf676863646.png)
+現在の売上管理シート↓
+![イメージ説明](f8648490b3414b426d5e27d0c3d128f4.png)
 売上管理シート完成見本↓
 ![売上管理シート](b9cfa39fef8607ff45f732329fcd5a9a.png)

説明の追加

2021/11/25 16:13

投稿

arin

スコア5

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -1,20 +1,26 @@
 ### 売上管理シート作成
+現在売上管理シートをを作成していて、連番と重複を１行にまとめるコードをを調べながら書いてる途中です。
-現在売上管理シートを調べながら作成してるのですが、わからないので教えてもらえると幸いです。
+下記の項目機能を作成したいのですが、全くわからないので下記の項目が動くコード教えてもらえると幸いです。
+・「No」は1からの連番を振り、1回の会計で1つのNoとする
+・1商品毎1行で表記する（同一会計内において、「No」と「販売日時」は垂直方向でセル結合をする）
+・「販売日時」は「会計」ボタンをを押した時点の日時とし、「YYYY/MM/DD hh:mm」の形式とする
+・価格を表示する部分は「￥9,999（￥は半角文字）」の形式とし、数字は整数表記とする
+・「販売額」は [単価×販売数]で計算する
 会計ボタンを押すと、明細シートのA1セル「商品コード」B1セル「商品名」C1セル「単価」の下に情報が記入された後に、売上管理シートに「No」「販売日時」「商品コード」「商品名」「単価」「販売数」「販売額」データを反映したいです。
-・「No」は1からの連番を振り、1回の会計で1つのNoとする
-・1商品毎1行で表記する（同一会計内において、「No」と「販売日時」は垂直方向でセル結合をする）
-・「販売日時」は「会計」ボタンをを押した時点の日時とし、「YYYY/MM/DD hh:mm」の形式とする
-・価格を表示する部分は「￥9,999（￥は半角文字）」の形式とし、数字は整数表記とする
-・「販売額」は [単価×販売数]で計算する
 削除ボタンがあるので、会計ボタンを押した後は明細シートの情報を消します。
@@ -68,6 +74,10 @@
     objChangePriceCell = objPaymentPriceCell - objTotalPriceCell
+    '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
     Dim k
     Dim lngNo As Long