[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『GetOpenFilenameのファイル指定を繰り返すには マクロ』（もも）
表題の件、悩んでいます。良い案があればアドバイスお願いします。
ExcelのSheet4に下図の1-3行目の情報があらかじめ入っています。
2行目は参照したいフォルダ年月を数式で取得している。
3行目は参照したいフォルダパスを2行目の年月も読み込んで数式で入れている。
やりたい事はマクロを稼働すると、GetOpenFilenameでまずももの3行目フォルダパス内が表示されるので自分でファイルを選択する。（もう1階層下のファイルの場合もあり）。続いて、みかんも同様にファイル選択する。
その結果、5行目のA列、B列に選択ファイルのフルパスが表示される。
ここまでは自力でマクロ動いたのですが、
次に、6行目以降も同様に、次のファイルのもも、みかんのセットでファイルを選択していきたいのですが、これをループ等でやる方法が分かりませんでした。例えば、10行目まで繰り返したいなら、11行目に来たらStopできるような仕組みもあったら欲しいです。
今考えているのは、5行目～必要行までマクロボタンを準備して、マクロもExcelに書き出すセルをWorksheets("Sheet4").Range("B6").Value = OpenFileName…、 Range("B7")、Range("B8")…とマクロコードを量産する位しか思いつかず、、アドバイス頂けますと嬉しいです。
＜Sheet4＞
A B 1 もも みかん 2 202306 202306 3 C:\Users\user\Desktop\もも\202306\ C:\Users\user\Desktop\みかん\202306\ 4 5 C:\Users\user\Desktop\もも\202306\fail\A-1.xlsx C:\Users\user\Desktop\みかん\202306\B-1.xlsx 6 ～同様処理したい～ ～同様処理したい～ 7 ～同様処理したい～ ～同様処理したい～ 8 ～同様処理したい～ ～同様処理したい～ 9 ～同様処理したい～ ～同様処理したい～ 10 ～同様処理したい～ ～同様処理したい～
＜今出来ている所までのコード＞
Sub Test()
Dim OpenFileName As String
Worksheets("Sheet4").Range("A5:B100").ClearContents
ChDir Worksheets("Sheet4").Range("A3").Value
MsgBox "出力したいももファイルを選択して下さい。"
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx")
If OpenFileName <> "False" Then
Worksheets("Sheet4").Range("A5").Value = OpenFileName
End If
ChDir Worksheets("Sheet4").Range("B3").Value
MsgBox "みかんファイルも同様に選択して下さい。"
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx")
If OpenFileName <> "False" Then
Worksheets("Sheet4").Range("B5").Value = OpenFileName
End If
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
下記のリンク先のサンプル2のコードを参考にしてコーディングしてみてください。
[ファイルを開く]ダイアログボックスを表示する（GetOpenFilenameメソッド）：Excel VBA｜即効テクニック
https://www.moug.net/tech/exvba/0060013.html
（hatena） 2023/07/22(土) 11:22:07
早速ありがとうございます。
上記コードで試してみましたが、今回やりたい事は厄介なことに「ももフォルダ」→「202306フォルダ」→この先の階層が同じももの中でも異なったりするのです。
教えて頂いたURLのやり方では恐らく同一フォルダのファイルを複数選択する場合だと思うので、うまくいきませんでした。
例1： C:\Users\user\Desktop\もも\202306\fail\A-1.xlsx ←fail
例2： C:\Users\user\Desktop\もも\202306\fail2\A-2.xlsx ←fail2
引き続き、何か良い案がありましたら、よろしくお願いいたします。
（もも） 2023/07/22(土) 12:37:16
A列のファイルとB列のファイルとの関係はなにかあるんですか？ いずれにしても、助言があったように、いったん対象となるものをシートに展開したうえで、 その組み合わせを再度決めればいいわけでしょ？
その都度 GetOpeFileNameを実行して一つずつ指定するのは効率が悪いでしょ？ という至極適切な助言だと思いましたけどねえ。
（xyz） 2023/07/22(土) 13:09:30
どうしても今のコードの延長線上でということなら、こうですか。
Dim k As Long
For k = 5 To 10 ' 最終行は適当です。修正してください。
ChDir Worksheets("Sheet4").Range("A3").Value
MsgBox "出力したいももファイルを選択して下さい。"
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx")
If OpenFileName <> "False" Then
Worksheets("Sheet4").Cells(k, "A").Value = OpenFileName
End If
ChDir Worksheets("Sheet4").Range("B3").Value
MsgBox "みかんファイルも同様に選択して下さい。"
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx")
If OpenFileName <> "False" Then
Worksheets("Sheet4").Cells(k, "B").Value = OpenFileName
End If
Next
（xyz） 2023/07/22(土) 13:43:14
Do ... Loop を使ったらどうでしょう。
Sub Test()
Dim myFile As Variant
Dim f As Variant
Dim r As Long
Worksheets("Sheet4").Range("A5:B100").ClearContents
ChDir Worksheets("Sheet4").Range("A3").Value
MsgBox "出力したいももファイルを選択して下さい。(複数選択可)" & vbCrLf & _
"選択終了するときはファイル選択ダイアログでキャンセルして下さい。"
r = 5
Do
myFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True)
If IsArray(myFile) Then
For Each f In myFile
Worksheets("Sheet4").Cells(r, "A").Value = f
r = r + 1
Next
Else
If myFile = False Then Exit Do 'キャンセルしたらループ終了
Worksheets("Sheet4").Range("S5").Value = myFile
r = r + 1
End
Loop Until r > 10 '10行を超えたらループ終了
'以下略
キャンセルするか10行を超えるまでファイル選択ダイアログが開きますので、 その都度別のフォルダーのファイルも選択できます。
（hatena） 2023/07/22(土) 16:06:46
色々とアドバイスありがとうございました。
＞ その都度 GetOpeFileNameを実行して一つずつ指定するのは効率が悪いでしょ？
仰る通りなのですが、A列とB列は関係があるが、ファイル名がバラバラ(似たような違う言い回し）でかつ、元データのファイル名を変える事は出来ない等ありまして、やむを得ずファイルを選択する方法にしました。
他の方法もあるのかと思いますが、、
xyz様にご提示いただいたコードの最終行を実行したいファイル数-4とし、一番最後にMsgBoxで処理が完了しましたの旨を表示させる事で、最初にやりたいと思っていた事が再現できました。
ありがとうございます。
hatena様の複数選択化のDo Loopの方法も大変参考になります。
今後、色々と活用していきたいと思います。
色々勉強になりました。ありがとうざいました。
（もも） 2023/07/22(土) 17:44:56
＞xyz様にご提示いただいたコードの最終行を実行したいファイル数-4とし
ファイル数 -4ではなく、+4でした。 訂正いたします。
ありがとうございました。
（もも） 2023/07/22(土) 17:53:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.