編集履歴

回答編集履歴

追記

2021/11/30 06:59

投稿

スコア4592

answer CHANGED Viewed

@@ -49,4 +49,70 @@
     End With
 End Sub
+```
+---
+＜追記＞　整理整頓。
+```VBA
+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 06:59

投稿

jinoji

スコア4592

answer CHANGED Viewed

@@ -1,52 +1,52 @@
-日時や金額の書式は最初にシートのセル書式を設定しておけばよいと思うので、
-Noとセル結合のところを書いておきます。
+修正して再掲。
 ```VBA
+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
-        With Worksheets("売上管理")
+    Set myDic = CreateObject("Scripting.Dictionary")
-             '
-             '
-            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
-        End With
-```
-（元のコードにも気になることはありますが一旦見ないふり・・・）
----
-＜追記＞
-```VBA
     'A列でリストの最終行を調べる
     Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
     With Worksheets("明細")
-        Dim c, n, t, s, g, arr
         For i = 2 To Arow
-            c = .Cells(i, 1).Value
+            ProductCode = .Cells(i, 1).Value
-            If Not myDic.Exists(c) Then
+            If Not myDic.Exists(ProductCode) Then
+                ProductName = .Cells(i, 2).Value
-                n = .Cells(i, 2).Value
+                Tanka = .Cells(i, 3).Value
-                t = .Cells(i, 3).Value
-                s = WorksheetFunction.CountIf(.Columns(1), c)
+                Hanbaisuu = WorksheetFunction.CountIf(.Columns(1), ProductCode)
-                g = t * s
-                arr = Array(c, n, t, s, g)
+                Hanbaigaku = Tanka * Hanbaisuu
+                varKodoNamePrice = Array(ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku)
                 '連想配列、キーとデータを追加する
-                myDic.Add c, arr
+                myDic.Add ProductCode, varKodoNamePrice
             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)
+            .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
 ```

追記

2021/11/30 02:28

投稿

jinoji

スコア4592

answer CHANGED Viewed

@@ -12,4 +12,41 @@
         End With
 ```
-（元のコードにも気になることはありますが一旦見ないふり・・・）
+（元のコードにも気になることはありますが一旦見ないふり・・・）
+---
+＜追記＞
+```VBA
+    'A列でリストの最終行を調べる
+    Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
+    With Worksheets("明細")
+        Dim c, n, t, s, g, arr
+        For i = 2 To Arow
+            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
+```

修正

2021/11/26 06:17

投稿

jinoji

スコア4592

answer CHANGED Viewed

@@ -7,8 +7,8 @@
              '
             lngNo = WorksheetFunction.Max(.Columns(1)) + 1
             .Cells(lngEndRow, 1).Offset(1).Value = lngNo
-            .Cells(lngEndRow, 1).Offset(1).Resize(Arow - 1).Merge
+            .Cells(lngEndRow, 1).Offset(1).Resize(myDic.Count).Merge
-            .Cells(lngEndRow, 2).Offset(1).Resize(Arow - 1).Merge
+            .Cells(lngEndRow, 2).Offset(1).Resize(myDic.Count).Merge
         End With
 ```