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

編集履歴

質問編集履歴

6

画像の追加

2021/11/30 06:15

投稿

arin
arin

スコア5

test CHANGED
File without changes
test CHANGED
@@ -32,7 +32,7 @@
32
32
 
33
33
  現在の売上管理シート↓
34
34
 
35
- ![イメージ説明](f8648490b3414b426d5e27d0c3d128f4.png)
35
+ ![イメージ説明](3673ca0a834b8eaecbc0eebb82cede84.png)
36
36
 
37
37
  売上管理シート完成見本↓
38
38
 

5

コード修正

2021/11/30 06:15

投稿

arin
arin

スコア5

test CHANGED
File without changes
test CHANGED
@@ -54,15 +54,11 @@
54
54
 
55
55
  Sub Total()
56
56
 
57
- '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
57
+ '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
58
-
59
- Dim k
60
58
 
61
59
  Dim lngNo As Long
62
60
 
63
61
  Dim strNitiji As String
64
-
65
- Dim varKodoNamePrice As Variant
66
62
 
67
63
  strNitiji = Format(Now, "YYYY/MM/DD hh:mm")
68
64
 
@@ -70,7 +66,9 @@
70
66
 
71
67
  Dim Arow As Long
72
68
 
73
- Dim i As Long, j As Long
69
+ Dim i As Long, j As Long, k As Long
70
+
71
+ k = 0
74
72
 
75
73
  Dim myDic As Object
76
74
 
@@ -92,15 +90,13 @@
92
90
 
93
91
 
94
92
 
95
-
96
-
97
- If myDic.Exists(ProductCode) = False Then
93
+ With Worksheets("明細")
98
94
 
99
95
  For i = 2 To Arow
100
96
 
101
- With Worksheets("明細")
97
+ ProductCode = .Cells(i, 1).Value
102
98
 
103
- ProductCode = .Cells(i, 1).Value
99
+ If myDic.Exists(ProductCode) = False Then
104
100
 
105
101
  ProductName = .Cells(i, 2).Value
106
102
 
@@ -114,39 +110,49 @@
114
110
 
115
111
  myDic.Add ProductCode, varArrayItems
116
112
 
117
- End With
113
+ End If
118
114
 
119
115
  Next
120
116
 
121
- With Worksheets("売上管理")
117
+ End With
122
118
 
123
- .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
119
+ With Worksheets("売上管理")
124
120
 
125
- For j = 0 To myDic.Count - 1
121
+ .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
126
122
 
127
- mykeys = myDic.Keys
123
+ For j = 0 To myDic.Count - 1
128
124
 
129
- myItems = myDic.Items
125
+ mykeys = myDic.Keys
130
126
 
131
- 'キーとデータをセルに表示する
127
+ myItems = myDic.Items
132
128
 
133
- .Range("C" & j + 2).Value = mykeys(j)
129
+ '販売日時、商品コード、商品名、単価、販売数、販売額を表示する
134
130
 
135
- .Range("D" & j + 2).Value = myItems(j)(j)
131
+ .Range("A" & j + 2).Value = lngNo + 1
136
132
 
137
- .Range("E" & j + 2).Value = myItems(j)(j + 1)
133
+ .Range("B" & j + 2).Value = strNitiji
138
134
 
139
- .Range("F" & j + 2).Value = myItems(j)(j + 2)
135
+ .Range("C" & j + 2).Value = mykeys(j)
140
136
 
141
- .Range("G" & j + 2).Value = myItems(j)(j + 3)
137
+ .Range("D" & j + 2).Value = myItems(j)(k)
142
138
 
143
- Next j
139
+ .Range("E" & j + 2).Value = myItems(j)(k + 1)
144
140
 
145
- End With
141
+ .Range("F" & j + 2).Value = myItems(j)(k + 2)
146
142
 
147
-
143
+ .Range("G" & j + 2).Value = myItems(j)(k + 3)
148
144
 
145
+ k = 0
146
+
147
+ Next j
148
+
149
- End If
149
+ End With
150
+
151
+
152
+
153
+ 'Dictionaryを初期化
154
+
155
+ myDic.RemoveAll
150
156
 
151
157
 
152
158
 

4

文変更

2021/11/30 05:24

投稿

arin
arin

スコア5

test CHANGED
File without changes
test CHANGED
@@ -54,7 +54,7 @@
54
54
 
55
55
  Sub Total()
56
56
 
57
- '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
57
+ '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
58
58
 
59
59
  Dim k
60
60
 
@@ -76,141 +76,79 @@
76
76
 
77
77
  Dim mykeys, myItems
78
78
 
79
- Dim RangeItems As Range
79
+ Dim varArrayItems As Variant
80
80
 
81
- For k = 2 To Cells(Rows.Count, 2).End(xlUp).Row
81
+ Dim ProductCode, ProductName, Tanka, Hanbaisuu, Hanbaigaku
82
82
 
83
- With Worksheets("売上管理")
83
+ 'Setステートメントで戻り値をオブジェクト変数に代入する
84
84
 
85
- If .Cells(lngEndRow, 1).Value = "No" Then
85
+ Set myDic = CreateObject("Scripting.Dictionary")
86
86
 
87
+
88
+
89
+ 'A列でリストの最終行を調べる
90
+
91
+ Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
92
+
93
+
94
+
95
+
96
+
97
+ If myDic.Exists(ProductCode) = False Then
98
+
99
+ For i = 2 To Arow
100
+
101
+ With Worksheets("明細")
102
+
103
+ ProductCode = .Cells(i, 1).Value
104
+
105
+ ProductName = .Cells(i, 2).Value
106
+
87
- '.Cells(lngEndRow, 1).Offset(1).Value = 1
107
+ Tanka = .Cells(i, 3).Value
108
+
109
+ Hanbaisuu = Application.WorksheetFunction.CountIf(.Range("B:B"), .Cells(i, 2).Value)
110
+
111
+ Hanbaigaku = Tanka * Hanbaisuu
112
+
113
+ varArrayItems = Array(ProductName, Tanka, Hanbaisuu, Hanbaigaku)
114
+
115
+ myDic.Add ProductCode, varArrayItems
116
+
117
+ End With
118
+
119
+ Next
120
+
121
+ With Worksheets("売上管理")
88
122
 
89
123
  .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
90
124
 
91
- 'Setステートメントで戻り値をオブジェクト変数に代入する
125
+ For j = 0 To myDic.Count - 1
92
126
 
127
+ mykeys = myDic.Keys
128
+
129
+ myItems = myDic.Items
130
+
131
+ 'キーとデータをセルに表示する
132
+
93
- Set myDic = CreateObject("Scripting.Dictionary")
133
+ .Range("C" & j + 2).Value = mykeys(j)
134
+
135
+ .Range("D" & j + 2).Value = myItems(j)(j)
136
+
137
+ .Range("E" & j + 2).Value = myItems(j)(j + 1)
138
+
139
+ .Range("F" & j + 2).Value = myItems(j)(j + 2)
140
+
141
+ .Range("G" & j + 2).Value = myItems(j)(j + 3)
142
+
143
+ Next j
144
+
145
+ End With
94
146
 
95
147
 
96
148
 
97
- 'A列でリストの最終行を調べる
149
+ End If
98
150
 
99
- Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
100
151
 
101
-
102
-
103
- '連想配列、キー重複の時エラーを無視
104
-
105
- On Error Resume Next
106
-
107
-
108
-
109
- For i = 2 To Arow
110
-
111
- RangeItems = Range(Worksheets("明細").Cells(i, 2).Value, Worksheets("明細").Cells(i, 3).Value)
112
-
113
- '連想配列、キーとデータを追加する
114
-
115
- myDic.Add Worksheets("明細").Cells(i, 1).Value, RangeItems
116
-
117
-
118
-
119
-
120
-
121
- For j = 0 To myDic.Count - 1
122
-
123
- mykeys = myDic.Keys
124
-
125
- myItems = myDic.RangeItems
126
-
127
-
128
-
129
- 'キーとデータをセルに表示する
130
-
131
- .Range("C" & j + 2).Value = mykeys(j)
132
-
133
- .Range("D" & j + 2).Value = myItems(i, j)
134
-
135
- Next j
136
-
137
- Next i
138
-
139
- 'オブジェクトを解放する
140
-
141
- Set myDic = Nothing
142
-
143
- .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)
144
-
145
- '.Cells(lngEndRow, 7).End(xlUp).Offset(1).Value = .Cells(k, 5).Value * .Cells(k, 6).Value
146
-
147
- Else
148
-
149
- '.Cells(lngEndRow, 1).Offset(1).Value = .Cells(lngEndRow - 1, 1).Value + 1
150
-
151
- .Cells(lngEndRow, 2).End(xlUp).Offset(1).Value = strNitiji
152
-
153
- 'Setステートメントで戻り値をオブジェクト変数に代入する
154
-
155
- Set myDic = CreateObject("Scripting.Dictionary")
156
-
157
-
158
-
159
- 'A列でリストの最終行を調べる
160
-
161
- Arow = Worksheets("明細").Cells(Rows.Count, 1).End(xlUp).Row
162
-
163
-
164
-
165
- '連想配列、キー重複の時エラーを無視
166
-
167
- On Error Resume Next
168
-
169
-
170
-
171
- For i = 2 To Arow
172
-
173
- RangeItems = Range(Worksheets("明細").Cells(i, 2).Value, Worksheets("明細").Cells(i, 3).Value)
174
-
175
- '連想配列、キーとデータを追加する
176
-
177
- myDic.Add Worksheets("明細").Cells(i, 1).Value, RangeItems
178
-
179
-
180
-
181
-
182
-
183
- For j = 0 To myDic.Count - 1
184
-
185
- mykeys = myDic.Keys
186
-
187
- myItems = myDic.RangeItems
188
-
189
-
190
-
191
- 'キーとデータをセルに表示する
192
-
193
- .Range("C" & j + 2).Offset.Value = mykeys(j)
194
-
195
- .Range("D" & j + 2).Offset.Value = myItems(i, j)
196
-
197
- Next j
198
-
199
- Next i
200
-
201
- 'オブジェクトを解放する
202
-
203
- Set myDic = Nothing
204
-
205
- .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)
206
-
207
- '.Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = .Cells(k, 5).Value * .Cells(k, 6).Value
208
-
209
- End If
210
-
211
- End With
212
-
213
- Next
214
152
 
215
153
  End Sub
216
154
 

3

省略化

2021/11/29 09:33

投稿

arin
arin

スコア5

test CHANGED
File without changes
test CHANGED
@@ -54,32 +54,6 @@
54
54
 
55
55
  Sub Total()
56
56
 
57
- ' --- 各セルのRangeオブジェクトを準備 ---
58
-
59
- Dim objTotalPriceCell As Range
60
-
61
- Dim objPaymentPriceCell As Range
62
-
63
- Dim objChangePriceCell As Range
64
-
65
- With Worksheets("商品登録")
66
-
67
- Set objTotalPriceCell = .Range("F10")
68
-
69
- Set objPaymentPriceCell = .Range("F13")
70
-
71
- Set objChangePriceCell = .Range("F15")
72
-
73
- End With
74
-
75
-
76
-
77
- 'おつりの計算
78
-
79
- objChangePriceCell = objPaymentPriceCell - objTotalPriceCell
80
-
81
-
82
-
83
57
  '売上管理のシートにNo、販売日時、商品コード、商品名、単価、販売数、販売額を記入
84
58
 
85
59
  Dim k

2

画像の追加

2021/11/26 10:11

投稿

arin
arin

スコア5

test CHANGED
File without changes
test CHANGED
@@ -30,6 +30,10 @@
30
30
 
31
31
  ![明細シート](43f772eff6255cad17503cf676863646.png)
32
32
 
33
+ 現在の売上管理シート↓
34
+
35
+ ![イメージ説明](f8648490b3414b426d5e27d0c3d128f4.png)
36
+
33
37
  売上管理シート完成見本↓
34
38
 
35
39
  ![売上管理シート](b9cfa39fef8607ff45f732329fcd5a9a.png)

1

説明の追加

2021/11/25 16:13

投稿

arin
arin

スコア5

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