回答編集履歴

2

コード加筆

2019/01/22 06:09

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -140,7 +140,15 @@
140
140
 
141
141
  Sub Sample2()
142
142
 
143
+ Dim wb1 As Workbook '購入履歴ブック
144
+
145
+ Dim ws1 As Worksheet '購入履歴シート
146
+
143
- Dim wb As Workbook
147
+ Dim wb2 As Workbook '在庫ブック
148
+
149
+ Dim ws2 As Worksheet '在庫シート
150
+
151
+
144
152
 
145
153
  Dim i As Integer
146
154
 
@@ -150,6 +158,8 @@
150
158
 
151
159
 
152
160
 
161
+ Dim rngSel As Range '選択されているセル範囲
162
+
153
163
  Dim tmp() As String '文字列配列で宣言
154
164
 
155
165
  Dim cnt As Integer 'Split結果の要素数カウンタ
@@ -158,34 +168,98 @@
158
168
 
159
169
  Application.ScreenUpdating = False
160
170
 
171
+
172
+
173
+ '購入者履歴ブック
174
+
175
+ Set wb1 = ThisWorkbook
176
+
177
+ 'Set ws1 = wb1.Worksheets("Sheet1")
178
+
179
+ Set ws1 = wb1.ActiveSheet
180
+
181
+
182
+
183
+ '在庫ブック
184
+
161
- Set wb = Workbooks.Open("C:\Users\在庫.xlsx")
185
+ Set wb2 = Workbooks.Open("C:\Users\在庫.xlsx")
186
+
162
-
187
+ 'Set ws2 = wb2.Worksheets("Sheet1")
188
+
163
-
189
+ Set ws2 = wb2.ActiveSheet
190
+
191
+
192
+
164
-
193
+ 'Selectionはアクティブなシートのみ取得できるため、対象シートをアクティブ化する
194
+
165
- ThisWorkbook.Activate
195
+ ws1.Activate
196
+
197
+
198
+
166
-
199
+ '選択範囲を変数に格納(※処理中のシート変更や別ブックのオープンによる誤動作を防止するため)
200
+
201
+ Set rngSel = Selection
202
+
203
+
204
+
205
+ '選択範囲をループ処理
206
+
167
- For i = Selection(1).Row To Selection(Selection.Count).Row
207
+ For i = rngSel(1).Row To rngSel(rngSel.Count).Row
168
-
169
- myselect = Cells(i, 3)
170
-
171
- tmp = Split(myselect.Value, vbLf)
172
208
 
173
209
 
174
210
 
211
+ myselect = ws1.Cells(i, 3)
212
+
213
+ tmp = Split(myselect, vbLf)
214
+
215
+
216
+
175
217
  For cnt = 0 To UBound(tmp)
176
218
 
219
+ 'シリアルの一致するセルを検索
220
+
177
- Set c = wb.Sheets("sheet1").Cells.Find(what:=tmp(cnt), LookAt:=xlWhole)
221
+ Set c = ws2.Cells.Find(what:=tmp(cnt), LookAt:=xlWhole)
222
+
223
+
224
+
178
-
225
+ If Not c Is Nothing Then
226
+
179
- '~後続の処理~
227
+ '一致するセルが見つかったら転記
228
+
180
-
229
+ ws2.Cells(c.Row, "B") = ws1.Cells(i, "B")
230
+
231
+ End If
232
+
181
- Next tmp
233
+ Next cnt
182
234
 
183
235
  Next i
184
236
 
237
+
238
+
239
+ 'ブックのクローズ
240
+
241
+ wb2.Close (False)
242
+
243
+ '解放
244
+
245
+ Set wb1 = Nothing
246
+
247
+ Set ws1 = Nothing
248
+
249
+ Set wb2 = Nothing
250
+
251
+ Set ws2 = Nothing
252
+
253
+
254
+
255
+ Application.ScreenUpdating = True
256
+
185
257
  End Sub
186
258
 
187
259
  ```
188
260
 
261
+ (※2019/01/22 15:00 対象シートの明示、および後続処理についてコード修正しました)
262
+
189
263
 
190
264
 
191
265
  その後の処理ですが、`Find`の結果は見つからない場合もあるので、lazybones2000さんのアドバイスのように`Nothing`の判定をしてから使用したほうが確実です。

1

syuusei

2019/01/22 06:09

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -20,15 +20,17 @@
20
20
 
21
21
 
22
22
 
23
- これは「選択されているセル範囲」の中で「先頭セル」の行から「最終セル」の行までをループする処理になっています。
23
+ これは(アクティブなシートで)「選択されているセル範囲」の中で「先頭セル」の行から「最終セル」の行までをループする処理になっています。
24
24
 
25
25
 
26
26
 
27
- 直前で開いたブック対象範囲を選択した状態で保存されているなら、想定した動作となるではないかと思います。
27
+ 購入履歴のブックで、対象範囲を選択した状態マクロを開始しその範囲を対象に処理したいものと思います。
28
28
 
29
- しかし今回のような形でエラが発生していというこそのよう状態で保存されていない(C列が空行を選択して保存されてる)、選択範囲内にC列が空の行が存在するかのどちらかと思われます。
29
+ しかしドを進めてい、ループの直前で開た在庫のブックがアクティブなるため想定した動作とていないのではないかと思ます。
30
30
 
31
31
 
32
+
33
+ 購入履歴のブックをアクティブ化にしてからループを行うことで意図したループとなると思います。
32
34
 
33
35
  まずはここらへんからご確認ください。
34
36
 
@@ -68,17 +70,13 @@
68
70
 
69
71
  `Set c = wb.Sheets("sheet5").Cells.Find(what:=tmp(0), LookAt:=xlWhole)`
70
72
 
71
- のように添え字をつけるのが正解なのですが、これもVB特有の冗長解釈で「添え字がなければ先頭の添え字」として処理されるため、既存コードでもエラーなく処理はされると思います。
73
+ のように添え字をつけるのが正解なのですが、これもVB特有の冗長解釈で「添え字がなければ先頭の添え字」として処理されるのと思います。
72
74
 
73
75
 
74
76
 
77
+ 今回は先頭だけでなく分解したすべての要素を処理したいものと思います。
75
78
 
76
-
77
- ただし今回は先頭だけでなく分解したすべての要素を処理したいものと思いますので、分解したすべての要素をループ処理する必要があります。
78
-
79
-
80
-
81
- lazybones2000さん回答にあるコードのようにSplitの結果要素を`For~Each`でループしてもいいですし、要素数を調べる`UBound`関数を利用して`For~Next`してもいいです。
79
+ lazybones2000さん回答にあるコードのようにSplitの結果要素を`For~Each`でループしてもいいですし、要素数を調べる`UBound`関数を利用して`For~Next`してもいいです。
82
80
 
83
81
 
84
82
 
@@ -109,6 +107,8 @@
109
107
  Set wb = Workbooks.Open("C:\Users\在庫.xlsx")
110
108
 
111
109
 
110
+
111
+ ThisWorkbook.Activate
112
112
 
113
113
  For i = Selection(1).Row To Selection(Selection.Count).Row
114
114
 
@@ -162,6 +162,8 @@
162
162
 
163
163
 
164
164
 
165
+ ThisWorkbook.Activate
166
+
165
167
  For i = Selection(1).Row To Selection(Selection.Count).Row
166
168
 
167
169
  myselect = Cells(i, 3)