質問編集履歴
2
コードの追加
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -261,3 +261,201 @@
|
|
|
261
261
|
コード
|
|
262
262
|
|
|
263
263
|
```
|
|
264
|
+
|
|
265
|
+
|
|
266
|
+
|
|
267
|
+
|
|
268
|
+
|
|
269
|
+
追って、ご教授いただいたコードを追加したのですが、Nextに対応するForがありません。とエラーが出ます。
|
|
270
|
+
|
|
271
|
+
```'
|
|
272
|
+
|
|
273
|
+
Sub マスターデータ取込03() '選択したファイルを取り込み、別のファイルに貼り付ける。
|
|
274
|
+
|
|
275
|
+
|
|
276
|
+
|
|
277
|
+
For Each f In fso.GetFolder(folderpath).Files
|
|
278
|
+
|
|
279
|
+
If fso.GetExtensionName Like "xls?" Then
|
|
280
|
+
|
|
281
|
+
Set wb = Workbooks.Open(f)
|
|
282
|
+
|
|
283
|
+
|
|
284
|
+
|
|
285
|
+
Dim RC As Integer
|
|
286
|
+
|
|
287
|
+
Dim OpenFileName, FileName, Path, SetFile As String
|
|
288
|
+
|
|
289
|
+
Dim wbMoto, wbSaki As Workbook
|
|
290
|
+
|
|
291
|
+
|
|
292
|
+
|
|
293
|
+
Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット
|
|
294
|
+
|
|
295
|
+
|
|
296
|
+
|
|
297
|
+
Application.DisplayAlerts = False
|
|
298
|
+
|
|
299
|
+
|
|
300
|
+
|
|
301
|
+
RC = MsgBox("マスターデータ取込みますか？", vbYesNo + vbQuestion, "確認")
|
|
302
|
+
|
|
303
|
+
|
|
304
|
+
|
|
305
|
+
If RC = vbYes Then
|
|
306
|
+
|
|
307
|
+
|
|
308
|
+
|
|
309
|
+
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
|
|
310
|
+
|
|
311
|
+
'ダイアログボックスを表示して、マスターデータファイルを指定します。
|
|
312
|
+
|
|
313
|
+
|
|
314
|
+
|
|
315
|
+
If OpenFileName <> "False" Then
|
|
316
|
+
|
|
317
|
+
SetFile = OpenFileName
|
|
318
|
+
|
|
319
|
+
Else
|
|
320
|
+
|
|
321
|
+
MsgBox "キャンセルされました"
|
|
322
|
+
|
|
323
|
+
Exit Sub 'マスターデータの取り込みをキャンセル
|
|
324
|
+
|
|
325
|
+
End If
|
|
326
|
+
|
|
327
|
+
|
|
328
|
+
|
|
329
|
+
|
|
330
|
+
|
|
331
|
+
Workbooks.Open FileName:=SetFile, ReadOnly:=True, UpdateLinks:=0
|
|
332
|
+
|
|
333
|
+
'ダイアログボックスで指定したマスターデータファイルを開きます。
|
|
334
|
+
|
|
335
|
+
|
|
336
|
+
|
|
337
|
+
Set wbSaki = Workbooks.Open(Path & SetFile)
|
|
338
|
+
|
|
339
|
+
|
|
340
|
+
|
|
341
|
+
'ワークブック間のシート「項目」をコピーします。
|
|
342
|
+
|
|
343
|
+
wbSaki.Worksheets("内訳書").Range("D:O").Copy
|
|
344
|
+
|
|
345
|
+
wbMoto.Worksheets("見積入力").Range("U7").PasteSpecial xlPasteValues
|
|
346
|
+
|
|
347
|
+
|
|
348
|
+
|
|
349
|
+
|
|
350
|
+
|
|
351
|
+
Application.CutCopyMode = False 'コピー切り取りを解除
|
|
352
|
+
|
|
353
|
+
wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる
|
|
354
|
+
|
|
355
|
+
|
|
356
|
+
|
|
357
|
+
Else
|
|
358
|
+
|
|
359
|
+
|
|
360
|
+
|
|
361
|
+
MsgBox "処理を中断します"
|
|
362
|
+
|
|
363
|
+
|
|
364
|
+
|
|
365
|
+
End If
|
|
366
|
+
|
|
367
|
+
|
|
368
|
+
|
|
369
|
+
Application.DisplayAlerts = True
|
|
370
|
+
|
|
371
|
+
|
|
372
|
+
|
|
373
|
+
Dim ans As String
|
|
374
|
+
|
|
375
|
+
ans = InputBox("見積書・請求書No", "", "")
|
|
376
|
+
|
|
377
|
+
|
|
378
|
+
|
|
379
|
+
If ans <> "" Then
|
|
380
|
+
|
|
381
|
+
wbMoto.Worksheets("見積").Range("I3").Value = ans
|
|
382
|
+
|
|
383
|
+
Worksheets("見積").Range("I3").Value = "ＶＨＭ-" & ans
|
|
384
|
+
|
|
385
|
+
|
|
386
|
+
|
|
387
|
+
End If
|
|
388
|
+
|
|
389
|
+
|
|
390
|
+
|
|
391
|
+
Application.DisplayAlerts = True
|
|
392
|
+
|
|
393
|
+
|
|
394
|
+
|
|
395
|
+
|
|
396
|
+
|
|
397
|
+
ans = InputBox("見積書発行日", "", "")
|
|
398
|
+
|
|
399
|
+
|
|
400
|
+
|
|
401
|
+
If ans <> "" Then
|
|
402
|
+
|
|
403
|
+
wbMoto.Worksheets("見積").Range("F11").Value = ans
|
|
404
|
+
|
|
405
|
+
End If
|
|
406
|
+
|
|
407
|
+
|
|
408
|
+
|
|
409
|
+
ans = InputBox("完工日", "", "")
|
|
410
|
+
|
|
411
|
+
|
|
412
|
+
|
|
413
|
+
If ans <> "" Then
|
|
414
|
+
|
|
415
|
+
wbMoto.Worksheets("請求").Range("F11").Value = ans
|
|
416
|
+
|
|
417
|
+
End If
|
|
418
|
+
|
|
419
|
+
|
|
420
|
+
|
|
421
|
+
ans = InputBox("請求書発行日", "", "")
|
|
422
|
+
|
|
423
|
+
|
|
424
|
+
|
|
425
|
+
If ans <> "" Then
|
|
426
|
+
|
|
427
|
+
wbMoto.Worksheets("請求").Range("F12").Value = ans
|
|
428
|
+
|
|
429
|
+
End If
|
|
430
|
+
|
|
431
|
+
|
|
432
|
+
|
|
433
|
+
Worksheets(Array(2, 3)).Select ' 1 番目と 2 番目のシートを選択
|
|
434
|
+
|
|
435
|
+
|
|
436
|
+
|
|
437
|
+
Dim xFile
|
|
438
|
+
|
|
439
|
+
xFile = Application.GetSaveAsFilename( _
|
|
440
|
+
|
|
441
|
+
FileFilter:="Excelファイル, *.xlsm")
|
|
442
|
+
|
|
443
|
+
If TypeName(xFile) <> "Boolean" Then
|
|
444
|
+
|
|
445
|
+
ActiveWorkbook.SaveAs FileName:=xFile
|
|
446
|
+
|
|
447
|
+
End If
|
|
448
|
+
|
|
449
|
+
|
|
450
|
+
|
|
451
|
+
Next
|
|
452
|
+
|
|
453
|
+
|
|
454
|
+
|
|
455
|
+
End Sub
|
|
456
|
+
|
|
457
|
+
|
|
458
|
+
|
|
459
|
+
コード
|
|
460
|
+
|
|
461
|
+
```
|
1
新たに見つけたコード
test
CHANGED
|
@@ -1 +1 @@
|
|
|
1
|
-
【VBA】一番初めの処理に戻って、同じ作業を繰り返す
|
|
1
|
+
【VBA】一番初めの処理に戻って、同じ作業を繰り返すことはできないのでしょうか？
|
test
CHANGED
|
@@ -209,3 +209,55 @@
|
|
|
209
209
|
コード
|
|
210
210
|
|
|
211
211
|
```
|
|
212
|
+
|
|
213
|
+
|
|
214
|
+
|
|
215
|
+
ちなみに、ファイルを順番に開き、上書き保存して閉じるといったコードは見つけました。
|
|
216
|
+
|
|
217
|
+
```Sub フォルダの中に含まれるファイルを順に編集する
|
|
218
|
+
|
|
219
|
+
|
|
220
|
+
|
|
221
|
+
Dim FolderName As String ’文字列を入れる変数として「FolderName」を使う
|
|
222
|
+
|
|
223
|
+
Dim index As Integer ’数字を入れる変数として「index」を使う
|
|
224
|
+
|
|
225
|
+
Dim FileName As String ’文字列を入れる変数として「FileName」を使う
|
|
226
|
+
|
|
227
|
+
FolderName = Application.GetOpenFilename’ダイアログを用いて選択したファイルのパスをFolderNameとする①
|
|
228
|
+
|
|
229
|
+
If FolderName = “False” Then’FolderNameが選択されていなければ作業を終了する
|
|
230
|
+
|
|
231
|
+
Exit Sub
|
|
232
|
+
|
|
233
|
+
End If
|
|
234
|
+
|
|
235
|
+
’今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。
|
|
236
|
+
|
|
237
|
+
index = InStrRev(FolderName, “\”)’フォルダ名部分の文字数をカウントする
|
|
238
|
+
|
|
239
|
+
FolderName = Left(FolderName, index)’ カウントした文字数までの部分を切り取ってフォルダ名とする
|
|
240
|
+
|
|
241
|
+
FileName = Dir(FolderName & “*xls*”)’ フォルダの中に含まれるファイルを取り出す
|
|
242
|
+
|
|
243
|
+
Do While FileName <> “”’ ファイルがなくなるまで繰り返す
|
|
244
|
+
|
|
245
|
+
Workbooks.Open FolderName & FileName’ファイルを開く
|
|
246
|
+
|
|
247
|
+
Cells(1,1) = 1’ 変更を行う
|
|
248
|
+
|
|
249
|
+
Workbooks(Workbooks.Count).Save
|
|
250
|
+
|
|
251
|
+
Workbooks(Workbooks.Count).Close
|
|
252
|
+
|
|
253
|
+
FileName = Dir() ’
|
|
254
|
+
|
|
255
|
+
Loop
|
|
256
|
+
|
|
257
|
+
|
|
258
|
+
|
|
259
|
+
End Sub
|
|
260
|
+
|
|
261
|
+
コード
|
|
262
|
+
|
|
263
|
+
```
|