Q&A
inputboxでの入力とかも含めて一から繰り返すということですか？
VBA初心者です。
普段から、コードはネットで調べて組み合わせて作っています。
今回、組み合わせたコードで処理を一番初めに戻って繰り返しさせたいです。
調べてみたのですが、VBAでは一番初めに戻るような処理はないのでしょうか？
今現在作ったコードでは
①データ読み取りをしたいExcelを開く、別ブックを開いて該当のセルに入力。セル自体に数式が入っているので各シートに反映されます。
②inputboxで各シートの該当セルに表示させたい文字を入力。
③3、4枚目のシートを選択。
④名前をつけて保存する。
という内容です。この1-４までの作成した処理を1番はじめまで戻って同じ処理を繰り返したいのですが、参考になる記事等が見つかりません。
なにかヒントをいただけないでしょうか。
よろしくお願いします。
Dim
1 Dim OpenFileName, fileName, Path, SetFile As String 2 Dim wbMoto, wbSaki As Workbook 3 4 Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット 5 6 Application.DisplayAlerts = False 7 8 RC = MsgBox("マスターデータ取込みますか？", vbYesNo + vbQuestion, "確認") 9 10 If RC = vbYes Then 11 12 OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 13 'ダイアログボックスを表示して、マスターデータファイルを指定します。 14 15 If OpenFileName <> "False" Then 16 SetFile = OpenFileName 17 Else 18 MsgBox "キャンセルされました" 19 Exit Sub 'マスターデータの取り込みをキャンセル 20 End If 21 22 23 Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 24 'ダイアログボックスで指定したマスターデータファイルを開きます。 25 26 Set wbSaki = Workbooks.Open(Path & SetFile) 27 28 'ワークブック間のシート「項目」をコピーします。 29 wbSaki.Worksheets("内訳書").Range("D:O").Copy 30 wbMoto.Worksheets("見積入力").Range("U7").PasteSpecial xlPasteValues 31 32 33 Application.CutCopyMode = False 'コピー切り取りを解除 34 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる 35 36 Else 37 38 MsgBox "処理を中断します" 39 40 End If 41 42 Application.DisplayAlerts = True 43 44 Dim ans As String 45 ans = InputBox("見積書・請求書No", "", "") 46 47 If ans <> "" Then 48 wbMoto.Worksheets("見積(").Range("I3").Value = ans 49 Worksheets("見積").Range("I3").Value = "あいう-" & ans 50 51 End If 52 53 Application.DisplayAlerts = True 54 55 56 ans = InputBox("見積書発行日", "", "") 57 58 If ans <> "" Then 59 wbMoto.Worksheets("見積").Range("F11").Value = ans 60 End If 61 62 ans = InputBox("完工日", "", "") 63 64 If ans <> "" Then 65 wbMoto.Worksheets("請求").Range("F11").Value = ans 66 End If 67 68 ans = InputBox("請求書発行日", "", "") 69 70 If ans <> "" Then 71 wbMoto.Worksheets("請求").Range("F12").Value = ans 72 End If 73 74 Worksheets(Array(2, 3)).Select '3 番目と 4 番目のシートを選択 75 76 Dim xFile 77 xFile = Application.GetSaveAsFilename( _ 78 FileFilter:="Excelファイル, *.xlsm") 79 If TypeName(xFile) <> "Boolean" Then 80 ActiveWorkbook.SaveAs FileName:=xFile 81 End If 82 End Sub 83' 84' 85 86コード 87コード
ちなみに、ファイルを順番に開き、上書き保存して閉じるといったコードは見つけました。
Sub
1 2Dim FolderName As String ’文字列を入れる変数として「FolderName」を使う 3Dim index As Integer ’数字を入れる変数として「index」を使う 4Dim FileName As String ’文字列を入れる変数として「FileName」を使う 5FolderName = Application.GetOpenFilename’ダイアログを用いて選択したファイルのパスをFolderNameとする① 6If FolderName = “False” Then’FolderNameが選択されていなければ作業を終了する 7Exit Sub 8End If 9’今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。 10index = InStrRev(FolderName, “\”)’フォルダ名部分の文字数をカウントする 11FolderName = Left(FolderName, index)’ カウントした文字数までの部分を切り取ってフォルダ名とする 12FileName = Dir(FolderName & “*xls*”)’ フォルダの中に含まれるファイルを取り出す 13Do While FileName <> “”’ ファイルがなくなるまで繰り返す 14Workbooks.Open FolderName & FileName’ファイルを開く 15Cells(1,1) = 1’ 変更を行う 16Workbooks(Workbooks.Count).Save 17Workbooks(Workbooks.Count).Close 18FileName = Dir() ’ 19Loop 20 21End Sub 22コード
追って、ご教授いただいたコードを追加したのですが、Nextに対応するForがありません。とエラーが出ます。
Sub マスターデータ取込03() '選択したファイルを取り込み、別のファイルに貼り付ける。 For Each f In fso.GetFolder(folderpath).Files If fso.GetExtensionName Like "xls?" Then Set wb = Workbooks.Open(f) Dim RC As Integer Dim OpenFileName, FileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット Application.DisplayAlerts = False RC = MsgBox("マスターデータ取込みますか？", vbYesNo + vbQuestion, "確認") If RC = vbYes Then OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。 If OpenFileName <> "False" Then SetFile = OpenFileName Else MsgBox "キャンセルされました" Exit Sub 'マスターデータの取り込みをキャンセル End If Workbooks.Open FileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'ダイアログボックスで指定したマスターデータファイルを開きます。 Set wbSaki = Workbooks.Open(Path & SetFile) 'ワークブック間のシート「項目」をコピーします。 wbSaki.Worksheets("内訳書").Range("D:O").Copy wbMoto.Worksheets("見積入力").Range("U7").PasteSpecial xlPasteValues Application.CutCopyMode = False 'コピー切り取りを解除 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる Else MsgBox "処理を中断します" End If Application.DisplayAlerts = True Dim ans As String ans = InputBox("見積書・請求書No", "", "") If ans <> "" Then wbMoto.Worksheets("見積").Range("I3").Value = ans Worksheets("見積").Range("I3").Value = "ＶＨＭ-" & ans End If Application.DisplayAlerts = True ans = InputBox("見積書発行日", "", "") If ans <> "" Then wbMoto.Worksheets("見積").Range("F11").Value = ans End If ans = InputBox("完工日", "", "") If ans <> "" Then wbMoto.Worksheets("請求").Range("F11").Value = ans End If ans = InputBox("請求書発行日", "", "") If ans <> "" Then wbMoto.Worksheets("請求").Range("F12").Value = ans End If Worksheets(Array(2, 3)).Select ' 1 番目と 2 番目のシートを選択 Dim xFile xFile = Application.GetSaveAsFilename( _ FileFilter:="Excelファイル, *.xlsm") If TypeName(xFile) <> "Boolean" Then ActiveWorkbook.SaveAs FileName:=xFile End If Next End Sub コード
そうです、Excelの取り込みから初めに戻るということです。
セル内での繰り返しやループは見つけましたが、vba内での繰り返しは無いのでしょうか^^;
やりたいことは、たとえばあるフォルダ内に複数のファイルがあって、
それを順番に開いて①～④の処理を行っていく、という感じなのでしょうか。
返信遅れてすみません。
わかりにくくてすみません、したいことはそうです！
For Each f in fso.GetFolder(folderpath).Files
if fso.GetExtensionName Like "xls?" Then
①Set wb=Workbooks.Open(f)
②
③
④
End If
Next
みたいなイメージです。
ご教授いただきました、内容を質問本文にコード追加いたしましt。
End Ifも入れているのですが、なぜかNextに対応するForがありません。とコンパイルエラーが出ました。
ヒントになればと思って部分的に示しただけで、単純に追加するだけで動くようには書いていません。
言葉足らずだった点は私の配慮が足りませんでしたが、
かといってすべて丁寧に説明しようとするには時間が足りません。
一旦私のコメントは聞かなかったことにしてください。
回答3件
0
サンプルコードを書きましたので、空のExcelを起ち上げてください
そのExcelシートのコードウィンドウにサンプルコードを貼り付けしてください
貼り付けしたら、ファイル名は何処でもよいので 「マクロ有効ｘlsm」で一度保存してください
今、保存したExcel（Book）を起動（開く）して下さい
次に、ディスクトップやドキュメントにあるExcelファイルを複数開いてください
Excelファイルを複数開いたら タスクバーから名前を付けて保存した ファイルを
画面に表示します
次にサンプルコードを貼り付けたコード（コードウィンドー）を画面に表示してください
ここからショートカットキーを使ってモニター画面を操作します
現在、モニター画面はコードウィンドーが表示されているとおもいます
［Windows]キー + ［→]キーでコードウィンドー右側半分表示されるはず
「矢印」キーで名前を付けて保存したファイルを選んで［Enter]キー
これで 画面は左がExcel、右側がコードウィンドー画面になっているとおもいます
右側のコードウィンドー画面を一度クリックしてから
ファンクションキー［F8]キーを押してください
［F8]キーを連打押してください 黄色いカーソルが表れて
下の方へ移動しているとおもいます。これでプログラム実行しています
マウスで変数名を左クリックしてみてください、現在取得している 値が表示
されます これでプログラムをチェックしながら 組んでいきます
一連の動きを理解したうえでご自身の組んだプログラムを挿入してみてください
不要とおもわれる構文は削除してください
エクセルマクロの勉強法（応用力を身に付ける方法）
http://www.start-macro.com/55/w/s027.html
VBA
1Sub サンプル() 2 Dim i As Long, ii As Long, str As String, a As Long, b As Long 3 'マクロ記述されているBookのパスを取得 4 str = ThisWorkbook.Path 5 MsgBox "名前付けたファイルパスは" _ 6 & Chr(10) & str & "です。" 7 '現在タスクバーにあるBookの数は 8 MsgBox "タスクバーにあるブック数は" _ 9 & Chr(10) & Workbooks.Count & "枚 です。" 10 For i = 1 To Workbooks.Count 11 '現在タスクバーにあるBook名を取得する 12 MsgBox "タスクバーにあるBook名は" & i & "個目は" & _ 13 Chr(10) & Workbooks(i).Name & "です" 14 15 '現在開いているBookのシート枚数は 16 a = Workbooks(i).Sheets.Count 17 Windows(Workbooks(i).Name).Activate 18 MsgBox "現在開いているBookのシート枚数は" & a & " 枚です" 19 b = MsgBox("ついでに、シート名も取得しますか？", vbYesNo) 20 If b = 6 Then 21 For ii = 1 To a 'aはBookのシート枚数 22 'シート名は左側から右側の順番 23 MsgBox Workbooks(i).Sheets(ii).Name & "です。" 24 Sheets(ii).Select 25 Range("A1").Select 26 Next ii 27 28 End If 29 'タスクバーにあるBook名を取得したパス 30 MsgBox "Bookのある場所は " & Workbooks(i).Path & "です" 31 'フルパスとして表示する 32 MsgBox "フルパスは " & Workbooks(i).Path & "\" & Workbooks(i).Name 33 Next i 34End Sub
投稿2021/09/03 06:42
総合スコア312
0
普通に考えればWhileとかでしょうが、処理の最後で自分自身を呼び出すというのでもできそうです。
If MsgBox("まだやるかい？", vbOKCancel) = vbOK Then Call 処理名
投稿2021/08/25 09:56
総合スコア4592
0
回数が決まってるならFor
不定で抜ける条件（例えば「終了しますか？」→yes）を設けるならwhile
でどうでしょう。
ちゃんと制御できるのならGotoも使えなくはないですが、別案があるときには選択しないほうが良いです。
投稿2021/08/25 09:08
総合スコア80875
あなたの回答
tips
プレビュー
