teratail
回答率
85.29%
質問するログイン新規登録
トップ18に関する質問売上管理シートの作成

編集履歴

質問編集履歴

6

画像の追加

2021/11/30 06:15

投稿

arin
arin

スコア5

title CHANGED
File without changes
body CHANGED
@@ -15,7 +15,7 @@
15
15
  会計ボタンを押した後の明細シート↓
16
16
  ![明細シート](43f772eff6255cad17503cf676863646.png)
17
17
  現在の売上管理シート↓
18
- ![イメージ説明](f8648490b3414b426d5e27d0c3d128f4.png)
18
+ ![イメージ説明](3673ca0a834b8eaecbc0eebb82cede84.png)
19
19
  売上管理シート完成見本↓
20
20
  ![売上管理シート](b9cfa39fef8607ff45f732329fcd5a9a.png)
21
21
 
18

5

コード修正

2021/11/30 06:15

投稿

arin
arin

スコア5

title CHANGED
File without changes
body CHANGED
@@ -26,15 +26,14 @@
26
26
  ```VBA
27
27
  '会計
28
28
  Sub Total()
29
- '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
29
+ '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
30
- Dim k
31
30
  Dim lngNo As Long
32
31
  Dim strNitiji As String
33
- Dim varKodoNamePrice As Variant
34
32
  strNitiji = Format(Now, "YYYY/MM/DD hh:mm")
35
33
  Dim lngEndRow: lngEndRow = Worksheets("売上管理").Cells(Rows.Count, 1).End(xlUp).Row
36
34
  Dim Arow As Long
37
- Dim i As Long, j As Long
35
+ Dim i As Long, j As Long, k As Long
36
+ k = 0
38
37
  Dim myDic As Object
39
38
  Dim mykeys, myItems
40
39
  Dim varArrayItems As Variant
@@ -45,34 +44,38 @@
45
44
  'A列でリストの最終行を調べる
46
45
  Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
47
46
 
48
-
49
- If myDic.Exists(ProductCode) = False Then
47
+ With Worksheets("明細")
50
48
  For i = 2 To Arow
51
- With Worksheets("明細")
52
- ProductCode = .Cells(i, 1).Value
49
+ ProductCode = .Cells(i, 1).Value
50
+ If myDic.Exists(ProductCode) = False Then
53
51
  ProductName = .Cells(i, 2).Value
54
52
  Tanka = .Cells(i, 3).Value
55
53
  Hanbaisuu = Application.WorksheetFunction.CountIf(.Range("B:B"), .Cells(i, 2).Value)
56
54
  Hanbaigaku = Tanka * Hanbaisuu
57
55
  varArrayItems = Array(ProductName, Tanka, Hanbaisuu, Hanbaigaku)
58
56
  myDic.Add ProductCode, varArrayItems
59
- End With
57
+ End If
60
58
  Next
59
+ End With
61
- With Worksheets("売上管理")
60
+ With Worksheets("売上管理")
62
- .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
61
+ .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
63
- For j = 0 To myDic.Count - 1
62
+ For j = 0 To myDic.Count - 1
64
- mykeys = myDic.Keys
63
+ mykeys = myDic.Keys
65
- myItems = myDic.Items
64
+ myItems = myDic.Items
66
- 'キーとデータをセルに表示する
65
+ '販売日時、商品コード、商品名、単価、販売数、販売額を表示する
66
+ .Range("A" & j + 2).Value = lngNo + 1
67
+ .Range("B" & j + 2).Value = strNitiji
67
- .Range("C" & j + 2).Value = mykeys(j)
68
+ .Range("C" & j + 2).Value = mykeys(j)
68
- .Range("D" & j + 2).Value = myItems(j)(j)
69
+ .Range("D" & j + 2).Value = myItems(j)(k)
69
- .Range("E" & j + 2).Value = myItems(j)(j + 1)
70
+ .Range("E" & j + 2).Value = myItems(j)(k + 1)
70
- .Range("F" & j + 2).Value = myItems(j)(j + 2)
71
+ .Range("F" & j + 2).Value = myItems(j)(k + 2)
71
- .Range("G" & j + 2).Value = myItems(j)(j + 3)
72
+ .Range("G" & j + 2).Value = myItems(j)(k + 3)
73
+ k = 0
72
- Next j
74
+ Next j
73
- End With
75
+ End With
76
+
74
-
77
+ 'Dictionaryを初期化
75
- End If
78
+ myDic.RemoveAll
76
79
 
77
80
  End Sub
78
81
  ```
18

4

文変更

2021/11/30 05:24

投稿

arin
arin

スコア5

title CHANGED
File without changes
body CHANGED
@@ -26,7 +26,7 @@
26
26
  ```VBA
27
27
  '会計
28
28
  Sub Total()
29
- '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
29
+ '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
30
30
  Dim k
31
31
  Dim lngNo As Long
32
32
  Dim strNitiji As String
@@ -37,74 +37,43 @@
37
37
  Dim i As Long, j As Long
38
38
  Dim myDic As Object
39
39
  Dim mykeys, myItems
40
- Dim RangeItems As Range
40
+ Dim varArrayItems As Variant
41
+ Dim ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku
42
+ 'Setステートメントで戻り値をオブジェクト変数に代入する
43
+ Set myDic = CreateObject("Scripting.Dictionary")
44
+
45
+ 'A列でリストの最終行を調べる
41
- For k = 2 To Cells(Rows.Count, 2).End(xlUp).Row
46
+ Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
47
+
48
+
49
+ If myDic.Exists(ProductCode) = False Then
50
+ For i = 2 To Arow
51
+ With Worksheets("明細")
52
+ ProductCode = .Cells(i, 1).Value
53
+ ProductName = .Cells(i, 2).Value
54
+ Tanka = .Cells(i, 3).Value
55
+ Hanbaisuu = Application.WorksheetFunction.CountIf(.Range("B:B"), .Cells(i, 2).Value)
56
+ Hanbaigaku = Tanka * Hanbaisuu
57
+ varArrayItems = Array(ProductName, Tanka, Hanbaisuu, Hanbaigaku)
58
+ myDic.Add ProductCode, varArrayItems
59
+ End With
60
+ Next
42
- With Worksheets("売上管理")
61
+ With Worksheets("売上管理")
43
- If .Cells(lngEndRow, 1).Value = "No" Then
44
- '.Cells(lngEndRow, 1).Offset(1).Value = 1
45
62
  .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
63
+ For j = 0 To myDic.Count - 1
64
+ mykeys = myDic.Keys
65
+ myItems = myDic.Items
46
- 'Setステートメントで戻り値をオブジェクト変数に代入する
66
+ 'キーとデータをセルに表示する
47
- Set myDic = CreateObject("Scripting.Dictionary")
67
+ .Range("C" & j + 2).Value = mykeys(j)
68
+ .Range("D" & j + 2).Value = myItems(j)(j)
69
+ .Range("E" & j + 2).Value = myItems(j)(j + 1)
70
+ .Range("F" & j + 2).Value = myItems(j)(j + 2)
71
+ .Range("G" & j + 2).Value = myItems(j)(j + 3)
72
+ Next j
73
+ End With
48
74
 
49
- 'A列でリストの最終行を調べる
50
- Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
51
-
52
- '連想配列、キー重複の時エラーを無視
53
- On Error Resume Next
54
-
55
- For i = 2 To Arow
56
- RangeItems = Range(Worksheets("明細").Cells(i, 2).Value, Worksheets("明細").Cells(i, 3).Value)
57
- '連想配列、キーとデータを追加する
58
- myDic.Add Worksheets("明細").Cells(i, 1).Value, RangeItems
59
-
60
-
61
- For j = 0 To myDic.Count - 1
62
- mykeys = myDic.Keys
63
- myItems = myDic.RangeItems
64
-
65
- 'キーとデータをセルに表示する
66
- .Range("C" & j + 2).Value = mykeys(j)
67
- .Range("D" & j + 2).Value = myItems(i, j)
68
- Next j
69
- Next i
70
- 'オブジェクトを解放する
71
- Set myDic = Nothing
72
- .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)
73
- '.Cells(lngEndRow, 7).End(xlUp).Offset(1).Value = .Cells(k, 5).Value * .Cells(k, 6).Value
74
- Else
75
- '.Cells(lngEndRow, 1).Offset(1).Value = .Cells(lngEndRow - 1, 1).Value + 1
76
- .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
77
- 'Setステートメントで戻り値をオブジェクト変数に代入する
78
- Set myDic = CreateObject("Scripting.Dictionary")
79
-
80
- 'A列でリストの最終行を調べる
81
- Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
82
-
83
- '連想配列、キー重複の時エラーを無視
84
- On Error Resume Next
85
-
86
- For i = 2 To Arow
87
- RangeItems = Range(Worksheets("明細").Cells(i, 2).Value, Worksheets("明細").Cells(i, 3).Value)
88
- '連想配列、キーとデータを追加する
89
- myDic.Add Worksheets("明細").Cells(i, 1).Value, RangeItems
90
-
91
-
92
- For j = 0 To myDic.Count - 1
93
- mykeys = myDic.Keys
94
- myItems = myDic.RangeItems
95
-
96
- 'キーとデータをセルに表示する
97
- .Range("C" & j + 2).Offset.Value = mykeys(j)
98
- .Range("D" & j + 2).Offset.Value = myItems(i, j)
99
- Next j
100
- Next i
101
- 'オブジェクトを解放する
102
- Set myDic = Nothing
103
- .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)
104
- '.Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = .Cells(k, 5).Value * .Cells(k, 6).Value
105
- End If
75
+ End If
106
- End With
76
+
107
- Next
108
77
  End Sub
109
78
  ```
110
79
 
18

3

省略化

2021/11/29 09:33

投稿

arin
arin

スコア5

title CHANGED
File without changes
body CHANGED
@@ -26,19 +26,6 @@
26
26
  ```VBA
27
27
  '会計
28
28
  Sub Total()
29
- ' --- 各セルのRangeオブジェクトを準備 ---
30
- Dim objTotalPriceCell As Range
31
- Dim objPaymentPriceCell As Range
32
- Dim objChangePriceCell As Range
33
- With Worksheets("商品登録")
34
- Set objTotalPriceCell = .Range("F10")
35
- Set objPaymentPriceCell = .Range("F13")
36
- Set objChangePriceCell = .Range("F15")
37
- End With
38
-
39
- 'おつりの計算
40
- objChangePriceCell = objPaymentPriceCell - objTotalPriceCell
41
-
42
29
  '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
43
30
  Dim k
44
31
  Dim lngNo As Long
18

2

画像の追加

2021/11/26 10:11

投稿

arin
arin

スコア5

title CHANGED
File without changes
body CHANGED
@@ -14,6 +14,8 @@
14
14
 
15
15
  会計ボタンを押した後の明細シート↓
16
16
  ![明細シート](43f772eff6255cad17503cf676863646.png)
17
+ 現在の売上管理シート↓
18
+ ![イメージ説明](f8648490b3414b426d5e27d0c3d128f4.png)
17
19
  売上管理シート完成見本↓
18
20
  ![売上管理シート](b9cfa39fef8607ff45f732329fcd5a9a.png)
19
21
 
18

1

説明の追加

2021/11/25 16:13

投稿

arin
arin

スコア5

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