質問編集履歴
1
コードの修正
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -14,8 +14,7 @@
|
|
|
14
14
|
### 発生している問題・エラーメッセージ
|
|
15
15
|
|
|
16
16
|
マクロ実行後のファイル容量の増加
|
|
17
|
-
|
|
17
|
+
|
|
18
|
-
をしています。
|
|
19
18
|
VBAの場合は、設定によりますが、コードの中間言語が保存され、修正されたあとに再び上書きされずに保存されるので、サイズが膨らんでいく、と別サイトでみたのですが、具体的な解決策がわかりません。
|
|
20
19
|
|
|
21
20
|
|
|
@@ -48,211 +47,6 @@
|
|
|
48
47
|
For Each conn In ActiveWorkbook.Connections
|
|
49
48
|
conn.Delete
|
|
50
49
|
Next conn
|
|
51
|
-
|
|
52
|
-
lastRow = Sheets("読込した出庫").Cells(Rows.Count, "Y").End(xlUp).Row
|
|
53
|
-
|
|
54
|
-
Sheets("読込した出庫").Activate
|
|
55
|
-
|
|
56
|
-
For i = 1 To lastRow
|
|
57
|
-
Sheets("読込した出庫").Cells(i, "Y").NumberFormat = "@"
|
|
58
|
-
Sheets("読込した出庫").Cells(i, "t").NumberFormat = "@"
|
|
59
|
-
|
|
60
|
-
If Not IsNumeric(Range("N" & i).Value) Or _
|
|
61
|
-
Not IsNumeric(Range("P" & i).Value) Or _
|
|
62
|
-
Not IsNumeric(Range("Q" & i).Value) Then
|
|
63
|
-
MsgBox i & "行目の個数、単価、出荷金額のいずれかが数値でありません。", vbExclamation, "エラー"
|
|
64
|
-
Else
|
|
65
|
-
'金額表示 Q列(17列目)にN列(14列目)×P列(16列目)を入力する
|
|
66
|
-
Sheets("読込した出庫").Cells(i, 17).Value = Sheets("読込した出庫").Cells(i, 14).Value * Sheets("読込した出庫").Cells(i, 16).Value
|
|
67
|
-
|
|
68
|
-
If Sheets("読込した出庫").Cells(i, "c").Value = 0 Then
|
|
69
|
-
Q = Q + 1
|
|
70
|
-
Sheets("読込した出庫").Cells(i, "c").Value = Q
|
|
71
|
-
End If
|
|
72
|
-
|
|
73
|
-
|
|
74
|
-
'4ケタ表示にならないプロジェクト番号を4ケタ表示する
|
|
75
|
-
Select Case Len(Cells(i, "y").Value)
|
|
76
|
-
Case Is = 1
|
|
77
|
-
Cells(i, "y").Value = "000" & Cells(i, "y").Value
|
|
78
|
-
Case Is = 2
|
|
79
|
-
Cells(i, "y").Value = "00" & Cells(i, "y").Value
|
|
80
|
-
Case Is = 3
|
|
81
|
-
Cells(i, "y").Value = "0" & Cells(i, "y").Value
|
|
82
|
-
End Select
|
|
83
|
-
|
|
84
|
-
Select Case Len(Cells(i, "t").Value)
|
|
85
|
-
Case Is = 1
|
|
86
|
-
Cells(i, "t").Value = "00" & Cells(i, "t").Value
|
|
87
|
-
Case Is = 0
|
|
88
|
-
Cells(i, "t").Value = "000" & Cells(i, "t").Value
|
|
89
|
-
End Select
|
|
90
|
-
End If
|
|
91
|
-
Next i
|
|
92
|
-
'体裁を整える
|
|
93
|
-
Sheets("読込した出庫").Range("A:Ac").EntireColumn.AutoFit
|
|
94
|
-
MsgBox "読込した出庫データが間違いないか確認ください。"
|
|
95
|
-
|
|
96
|
-
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
|
|
97
|
-
lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
|
|
98
|
-
|
|
99
|
-
' 削除対象の列を選択する
|
|
100
|
-
Set rng = ActiveSheet.Range(Cells(1, lastcol + 1), Cells(lastRow, Columns.Count))
|
|
101
|
-
|
|
102
|
-
' 列を削除する
|
|
103
|
-
rng.Delete Shift:=xlToLeft
|
|
104
|
-
|
|
105
|
-
' Sub 複合品処理()
|
|
106
|
-
Dim searchValue As String
|
|
107
|
-
Dim lastRow2 As Long
|
|
108
|
-
Dim lastRow3 As Long
|
|
109
|
-
Dim lastrow5 As Long
|
|
110
|
-
Dim h As Long, j As Long, k As Long, l As Long, m As Long, n As Long
|
|
111
|
-
Dim matchFound As Boolean
|
|
112
|
-
|
|
113
|
-
|
|
114
|
-
Sheets("複合品処理用").Rows("2:" & Cells.Rows.Count).ClearContents
|
|
115
|
-
'複合品マスタシートの最終行を取得します
|
|
116
|
-
lastRow2 = Sheets("複合品マスタ").Cells(Rows.Count, 2).End(xlUp).Row
|
|
117
|
-
|
|
118
|
-
'Z=複合品コード数
|
|
119
|
-
Z = Sheets("スタート").Range("m30").Value
|
|
120
|
-
If Z = "" Then
|
|
121
|
-
MsgBox ("スタートのM30に現在登録されている複合品コード数を入力してください")
|
|
122
|
-
Else
|
|
123
|
-
' K=検索する複合品コード
|
|
124
|
-
For k = 1 To Z
|
|
125
|
-
searchValue = CStr(k)
|
|
126
|
-
matchFound = False
|
|
127
|
-
|
|
128
|
-
'読込シートの最終行を取得します
|
|
129
|
-
lastRow = Sheets("読込した出庫").Cells(Rows.Count, 2).End(xlUp).Row
|
|
130
|
-
' L＝読込シートで検索値を見つける段数 iは商品コード列
|
|
131
|
-
For l = 1 To lastRow
|
|
132
|
-
' '読込シートの最終行を取得します
|
|
133
|
-
lastRow = Sheets("読込した出庫").Cells(Rows.Count, 2).End(xlUp).Row
|
|
134
|
-
If UCase(Sheets("読込した出庫").Cells(l, "i").Value) = UCase(searchValue) Then
|
|
135
|
-
|
|
136
|
-
MsgBox ("複合品No" & k & "の構成品を出力します。")
|
|
137
|
-
Sheets("複合品処理用").Activate
|
|
138
|
-
' i=複合品マスタで検索値を見つける段数 複合品マスタシートの各行に対してループします
|
|
139
|
-
|
|
140
|
-
m = 0
|
|
141
|
-
For h = 1 To lastRow2
|
|
142
|
-
|
|
143
|
-
lastRow3 = Sheets("複合品処理用").Cells(Rows.Count, 2).End(xlUp).Row
|
|
144
|
-
' 複合品マスタでNoから構成品を探す
|
|
145
|
-
If InStr(1, Sheets("複合品マスタ").Cells(h, "a").Value, searchValue, vbTextCompare) > 0 Then
|
|
146
|
-
matchFound = True
|
|
147
|
-
m = m + 1
|
|
148
|
-
|
|
149
|
-
'============読込シートから処理用シートにコピーして、、 ＝＝＝＝＝＝＝＝＝＝ー
|
|
150
|
-
Sheets("読込した出庫").Rows(l).Copy Sheets("複合品処理用").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
|
|
151
|
-
'＝＝＝＝＝＝＝＝＝＝＝「商品名、単位、仕入単価」は複合品マスタから上書き＝＝＝＝
|
|
152
|
-
'商品コード9列目
|
|
153
|
-
Sheets("複合品処理用").Cells(lastRow3 + 1, 9).Value = Sheets("複合品マスタ").Range("c" & h).Value
|
|
154
|
-
'商品名10列目
|
|
155
|
-
Sheets("複合品処理用").Cells(lastRow3 + 1, 10).Value = Sheets("複合品マスタ").Range("d" & h).Value
|
|
156
|
-
'規格21列目
|
|
157
|
-
Sheets("複合品処理用").Cells(lastRow3 + 1, 21).Value = Sheets("複合品マスタ").Range("f" & h).Value
|
|
158
|
-
'単位15列目
|
|
159
|
-
Sheets("複合品処理用").Cells(lastRow3 + 1, 15).Value = Sheets("複合品マスタ").Range("e" & h).Value
|
|
160
|
-
'単価16列目
|
|
161
|
-
Sheets("複合品処理用").Cells(lastRow3 + 1, 16).Value = Sheets("複合品マスタ").Range("g" & h).Value
|
|
162
|
-
'個数14行目は、元の数値に複合品マスタの数を掛けた値を代入する
|
|
163
|
-
Sheets("複合品処理用").Cells(lastRow3 + 1, 14).Value = Sheets("複合品マスタ").Range("b" & h).Value * Sheets("複合品処理用").Cells(lastRow3 + 1, 14).Value
|
|
164
|
-
|
|
165
|
-
|
|
166
|
-
End If
|
|
167
|
-
|
|
168
|
-
Next h
|
|
169
|
-
If m = 0 Then
|
|
170
|
-
Sheets("複合品処理用").Range("A:ac").EntireColumn.AutoFit
|
|
171
|
-
MsgBox ("複合品コード" & k & "は、マスタ登録されていません。")
|
|
172
|
-
Else
|
|
173
|
-
MsgBox (k & "の構成品を出力しました。")
|
|
174
|
-
|
|
175
|
-
End If
|
|
176
|
-
End If
|
|
177
|
-
Next l
|
|
178
|
-
|
|
179
|
-
' 検索値が複合品マスタシートに存在しなかった場合はメッセージを表示します
|
|
180
|
-
' If Not matchFound Then
|
|
181
|
-
' MsgBox "検索値 " & searchValue & " は複合品マスタシートに存在しません。", vbInformation, "情報"
|
|
182
|
-
' End If
|
|
183
|
-
Next k
|
|
184
|
-
End If
|
|
185
|
-
|
|
186
|
-
lastrow5 = Sheets("複合品処理用").Cells(Rows.Count, 2).End(xlUp).Row
|
|
187
|
-
If Sheets("複合品処理用").Range("b2") <> 0 Then
|
|
188
|
-
For n = 2 To lastrow5
|
|
189
|
-
Sheets("複合品処理用").Cells(n, "Y").NumberFormat = "@"
|
|
190
|
-
Sheets("複合品処理用").Cells(n, "t").NumberFormat = "@"
|
|
191
|
-
|
|
192
|
-
|
|
193
|
-
'金額表示 Q列(17列目)にN列(14列目)×P列(16列目)を入力する
|
|
194
|
-
Sheets("複合品処理用").Cells(n, 17).Value = Sheets("複合品処理用").Cells(n, 14).Value * Sheets("複合品処理用").Cells(n, 16).Value
|
|
195
|
-
|
|
196
|
-
'4ケタ表示にならないプロジェクト番号を4ケタ表示する
|
|
197
|
-
Select Case Len(Cells(n, "y").Value)
|
|
198
|
-
Case Is = 1
|
|
199
|
-
Cells(n, "y").Value = "000" & Cells(n, "y").Value
|
|
200
|
-
Case Is = 2
|
|
201
|
-
Cells(n, "y").Value = "00" & Cells(n, "y").Value
|
|
202
|
-
Case Is = 3
|
|
203
|
-
Cells(n, "y").Value = "0" & Cells(n, "y").Value
|
|
204
|
-
End Select
|
|
205
|
-
|
|
206
|
-
Select Case Len(Cells(n, "t").Value)
|
|
207
|
-
Case Is = 1
|
|
208
|
-
Cells(n, "t").Value = "00" & Cells(n, "t").Value
|
|
209
|
-
Case Is = 0
|
|
210
|
-
Cells(n, "t").Value = "000" & Cells(n, "t").Value
|
|
211
|
-
End Select
|
|
212
|
-
Next n
|
|
213
|
-
End If
|
|
214
|
-
MsgBox ("分解したコードを読込シートに転記します。")
|
|
215
|
-
|
|
216
|
-
'Sub 複合品コードを転記()
|
|
217
|
-
|
|
218
|
-
Dim lastRow4 As Long
|
|
219
|
-
Dim lastrow6 As Long
|
|
220
|
-
|
|
221
|
-
lastRow4 = Sheets("読込した出庫").Cells(Rows.Count, 2).End(xlUp).Row
|
|
222
|
-
lastrow6 = Sheets("複合品処理用").Cells(Rows.Count, 2).End(xlUp).Row
|
|
223
|
-
|
|
224
|
-
|
|
225
|
-
Sheets("読込した出庫").Activate
|
|
226
|
-
|
|
227
|
-
'複合品がない場合スキップする
|
|
228
|
-
If lastrow5 < 2 Then
|
|
229
|
-
MsgBox ("複合品がありません。")
|
|
230
|
-
Else
|
|
231
|
-
|
|
232
|
-
Sheets("複合品処理用").Range("a2:ac" & lastrow5).Copy Destination:=Sheets("読込した出庫").Range("A" & lastRow4 + 1)
|
|
233
|
-
|
|
234
|
-
Sheets("読込した出庫").Range("A:ac").EntireColumn.AutoFit
|
|
235
|
-
|
|
236
|
-
MsgBox ("転記終了しました。")
|
|
237
|
-
End If
|
|
238
|
-
|
|
239
|
-
lastRow4 = Sheets("読込した出庫").Cells(Rows.Count, 2).End(xlUp).Row
|
|
240
|
-
|
|
241
|
-
For x = lastRow4 To 1 Step -1 '下から上に向かってループ
|
|
242
|
-
y = y + 1
|
|
243
|
-
'Z(複合品コードの数)まで調べて削除する
|
|
244
|
-
If Sheets("読込した出庫").Cells(x, "I").Value >= 1 And Sheets("読込した出庫").Cells(x, "I").Value <= Z Then
|
|
245
|
-
MsgBox (x & "行目の複合品入力行を削除します")
|
|
246
|
-
Rows(x).Delete
|
|
247
|
-
End If
|
|
248
|
-
Next x
|
|
249
|
-
|
|
250
|
-
Sheets("読込した出庫").Range("A:ac").EntireColumn.AutoFit
|
|
251
|
-
Result = MsgBox("複合品行の差し替えが終了しました。" & vbCrLf & "複合品処理用シートをクリアしますか?", vbYesNo + vbQuestion, "Open File")
|
|
252
|
-
If Result = vbYes Then
|
|
253
|
-
Sheets("複合品処理用").Rows("2:" & Cells.Rows.Count).ClearContents
|
|
254
|
-
End If
|
|
255
|
-
|
|
256
50
|
|
|
257
51
|
End Sub
|
|
258
52
|
|