質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

1回答

604閲覧

フォルダ選択ダイアログからフォルダをしてい

Gamagaeru

総合スコア11

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2021/04/22 09:00

こちらのコードは元々、マクロが入っているフォルダの中にある
ファイルの値を取得するコードなのですが、
ファイル選択ダイアログをだして、選んだフォルダの中にあるファイルから値を取得するように変えたいです。
このコードを使おうと思っています。
'フォルダを選択します。
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

'キャンセルボタンクリック時にマクロを終了 If dlg.Show = False Then Exit Sub

どのようにすると、うまくいきますか。
よろしくお願いします。

Dim wFile As String Dim wFilePath As String Dim i As Long 'Excelファイルが存在していたらファイル名を返す wFile = Dir(ActiveWorkbook.Path & "*.xlsx") Sheets("単体テスト仕様書").Range("A2:D31").ClearContents '先頭行を指定 i = 2 'カレントディレクトリに存在するExcelファイルを全て読み込む Do While wFile <> "" '開くExcelファイルのフルパスを取得 wFilePath = ActiveWorkbook.Path & "\" & wFile '機能(プログラム)名・テスト件数・完了数・不具合件数を取得し配列に格納する(区切り文字:|) strData = Split(File_Load(wFilePath), "|") '機能(プログラム)名 Cells(i, 1) = strData(0) 'テスト件数 Cells(i, 2) = strData(1) '完了数 Cells(i, 3) = strData(2) '不具合件数 Cells(i, 4) = strData(3) '次のExcelファイルを取得 wFile = Dir() '行数をカウント i = i + 1 Loop MsgBox "完了" End Sub Function File_Load(ByVal wFilePath As String) As String Dim wb As Workbook Dim wItem As Variant Dim i As Long Dim FoundCell As Object Set wb = Workbooks.Open(wFilePath) wItem = Array("作成者", "テスト件数", "完了数", "不具合件数") For i = LBound(wItem) To UBound(wItem) Set FoundCell = wb.Worksheets(1).Cells.Find(What:=wItem(i)) If FoundCell Is Nothing Then wItem(i) = "" Else wItem(i) = FoundCell.Offset(1, 0).Value End If Next i wb.Close SaveChanges:=False File_Load = Join(wItem, "|") End Function

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

y_waiwai

2021/04/22 09:36

どういうふうにうまくいかないんでしょうか
Gamagaeru

2021/04/23 00:50

こちらは、カレントディレクトリに存在するExcelファイルを全て読み込む処理になっていいるのですが、 フォルダ選択のダイアログをだして、選択したフォルダに入っているすべてのエクセルファイルを 読み込むようにしたいです。その際に、フォルダ選択のダイアログは出たのですが、そこに入っている、 すべてのファイルの読み取りがうまくいっていない状況です。
guest

回答1

0

こんな感じでどうでしょうか。

VBA

1 Dim wFile As String 2 Dim wFilePath As String 3 Dim i As Long 4 5 Dim dlg As FileDialog 6 Dim wSelFolder As String 7 8 'フォルダを選択します。 9 Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 10 'キャンセルボタンクリック時にマクロを終了 11 If dlg.Show = False Then Exit Sub 12 wSelFolder = dlg.SelectedItems(1) 13 14 'Excelファイルが存在していたらファイル名を返す 15 wFile = Dir(wSelFolder & "*.xlsx") 16 'ActiveWorkbook.Path を wSelFolder に変更 (以降も同様に) 17 18 19

投稿2021/04/22 09:25

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問