[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『任意のフォルダを選択し、フォルダ内にある複数のbookを1つのシートにまとめるプログラム』(初心者)
Sub 取込み_Click()
Dim fd As FileDialog Dim folderName As String Dim wb As Workbook Dim sh As Worksheet Dim i As Long Dim FileName As String
With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False '複数選択しない .Title = "Excelファイルが保存されているフォルダを選択"
If .Show = True Then folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納 Else Exit Sub 'フォルダが選択されなかった場合は処理終了 End If End With
i = 2 FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While FileName <> "" If FileName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & FileName, False, True)
For Each sh In wb.Worksheets
With ThisWorkbook.Worksheets("データ")
.Cells(Rout, "B").Value = sh.Range("D3").Value .Cells(Rout, "E").Value = sh.Range("K3").Value End With
i = i + 1 Next sh wb.Close False
End If FileName = Dir Loop End Sub
< 使用 Excel:Excel2016、使用 OS:Windows10 >
(わからん) 2021/11/26(金) 12:45
(もこな2) 2021/11/26(金) 13:09
わからん 回答がわかりません、
もこな2 参考資料ありがとうございます!
見てみます!
(初心者) 2021/11/26(金) 14:17
なお、言及がありませんが、提示のトピックと十中八九同じ方だとおもいますが、参考にしただけで別人という場合。
・「folderPath」を取得しているものの使ってないので無駄ですよ
・「Rout」をどこかで取得しないと空っぽのままですから↓のように書いたら実行時エラーになりますよ .Cells(Rout, "B").Value
・上記に関連しますが「folderPath」「Rout」の変数宣言がありません。 なくても動くかもしれませんが、初心者と仰るのであれば、なおさら変数宣言する癖をつけたほうがよいとおもいます。 【参考】 http://officetanaka.net/excel/vba/beginner/06.htm
・ざっと見て間違ってはいないようですが、「With」〜「End With」、「If」〜「End If」、「Do」〜「Loop」 それぞれ、インデント位置は揃えたほうが構造を把握しやすくなると思いますよ
上記を踏まえた修正後にステップ実行などで自己検証してから、具体的な問題を挙げて質問されるとよいでしょう。
(もこな2) 2021/11/26(金) 14:26
単にコードを提示されただけなので、何を聞きたいのかおたずねしたのです。
ちなみに、こちらで似たような質問がありますので、ご参考に。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12253057292?__ysp=Um91dA%3D%3D
(わからん) 2021/11/26(金) 15:58
ありがとうございます。
任意のフォルダを選択し、その中にある複数エクセルbookを
1つのシートに纏めたいと思っています。
現在のエラーは、一つのエクセルbookを選んでしまうコードになっており、
選択したフォルダにあるbook以外をまとめるようにしたいです。
操作する想定をしていますのは、
一つのフォルダの保存先が、Cドライブだったり、Dドライブだったりするので、
保存先がまちまちであることから、マクロを実行する際に、
取り出すフォルダを選び、その中にあるエクセルbookを読み出すようにしたいです。
エラーは、>FileName = Dir(folderPath & "\*.xlsx")で止まっており、
ステップイン実行にて、確認していたのですが、1つのエクセルbookの受渡しで止まっております。
解決策が思いつかず、教えて頂けないでしょうか。
Sub 取込み_Click()
Dim fd As FileDialog 'フォルダを選択 Dim folderPath As String 'フォルダパスを取得 Dim wb As Workbook '転記先のワークシート Dim sh As Worksheet '元のワークシート Dim i As Long '列の番号制御用 Dim FileName As String 'ファイル名を取得
With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False '複数選択しない .Title = "Excelファイルが保存されているフォルダを選択"
If .Show = True Then folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納 Else Exit Sub 'フォルダが選択されなかった場合は処理終了 End If End With
i = 2 FileName = Dir(folderPath & "\*.xlsx")
Do While FileName <> "" If FileName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & FileName, False, True)
For Each sh In wb.Worksheets With ThisWorkbook.Worksheets("データ") .Cells(i, "B").Value = sh.Range("D3").Value .Cells(i, "E").Value = sh.Range("K3").Value End With i = i + 1 Next sh
wb.Close False
End If
FileName = Dir
Loop
End Sub
(初心者) 2021/11/26(金) 16:56
フォルダを選択するのではなく、ファイルを選択しているからでしょう。
最初に提示されたコードではフォルダを選択していたのに、変えてしまったのですね。
(わからん) 2021/11/26(金) 17:25
既に指摘があるところですが、こういうことです。
Sub 最初に提示したもの() Dim folderPath As String With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False '複数選択しない .Title = "Excelファイルが保存されているフォルダを選択" If .Show = True Then folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納 Else Exit Sub 'フォルダが選択されなかった場合は処理終了 End If End With
MsgBox folderPath & vbLf & vbLf & "↑の【フォルダ】が選択されました" End Sub '--------------------------------------------------------------------------------------------- Sub 次に示されたもの() Dim folderPath As String 'フォルダパスを取得
With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False '複数選択しない .Title = "Excelファイルが保存されているフォルダを選択" If .Show = True Then folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納 Else Exit Sub 'フォルダが選択されなかった場合は処理終了 End If End With
MsgBox folderPath & vbLf & vbLf & "↑の【ファイル】が選択されました" End Sub
そして、何故問題がでるのかは、[[20211114090213]]の■5で指摘済です。
さらに、本当にステップ実行しているのであれば、[[20211114090213]]の■7でコメントしたように
アレレ、「FilePath」にファイルパスが入るぞ アレレ、「FileName」が最初から""になってしまうぞ
となるはずですが、そこで疑問に思わなかったのですか?
■2
>取り出すフォルダを選び、その中にあるエクセルbookを読み出すようにしたいです。
↑のようにするのですから、【フォルダ】を選択するようにすべきですし、↓をその【フォルダ】から探すように修正すべきだと前々から言っているつもりです。
FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
■3
>参考資料ありがとうございます!見てみます!
あたかも、別人のような書きぶりですが、失敗してるところや変数名を見ても、同じ方であろうことは容易に推測できます。
本当に別人ならごめんなさいですが、同じ方なら、ニックネームを統一する、トピックを放り出して新しいトピックをたてないなど、マナーは守られたほうが良いと思います。
(無論、規約上NG行為ではありませんから最終的にはご自身の判断になるでしょうが、回答を付けた立場からすれば、気持ちの良い行動ではありません)
また、マルチポストをされているようですが、そちらでもコメントが付いていると思います。
このサイトはマルチポストを許容していますが、同時に↓のように書いてあるので、実行されたほうが良いでしょう
・[マルチポストで書き込んだ方]は他の掲示板で解決した内容をこのボードでも公開して、 書き込みが将来他の人の役に立つように協力してください
(もこな2) 2021/11/26(金) 18:25
ありがとうございます。
はい。ステップ実行しています。
> アレレ、「FilePath」にファイルパスが入るぞ
>アレレ、「FileName」が最初から""になってしまうぞ
となるはずですが、そこで疑問に思わなかったのですか?
対処方法がわかりませんでした。
教えて頂いていますし、顔が見えないネットの世界では。
誹謗中傷はあると思っています。
(初心者) 2021/11/26(金) 19:10
任意で選ぶので、初期では、"”になると思っていましたので、
疑問に思いませんでした。
今でも、疑問に思わないです
(初心者) 2021/11/26(金) 19:27
Sub 取込み_Click() Dim fd As FileDialog Dim folderPath As String Dim FileName As String Dim wb As Workbook Dim sh As Worksheet Dim i As Long
Set fd = Application.FileDialog(msoFileDialogFolderPicker) If Not fd.Show Then Exit Sub folderPath = fd.SelectedItems(1)
i = 2 FileName = Dir(folderPath & "\*.xlsx") Do While FileName <> "" Set wb = Workbooks.Open(folderPath & "\" & FileName, False, True) For Each sh In wb.Worksheets With ThisWorkbook.Worksheets("データ") .Cells(i, "B").Value = sh.Range("D3").Value .Cells(i, "E").Value = sh.Range("K3").Value End With i = i + 1 Next sh wb.Close False FileName = Dir Loop
End Sub
(マナ) 2021/11/26(金) 19:34
■4
>任意で選ぶので、初期では、"”になると思っていましたので、
>疑問に思いませんでした。
>今でも、疑問に思わないです
ではそこから解決しないとですね。
Do While FileName <> "" 〜〜〜〜〜〜〜 Loop
↑は
「FileName」の中身が「""」で無ければ 〜〜〜〜〜〜〜 をしなさい 繰り返し
ということになっています。ここまでは良いですか?
Sub 実験01() Dim MySTR As String
MySTR = "" Do While MySTR <> "" MsgBox "Hello" MySTR = "" Loop End Sub '------------------------------------ Sub 実験02() Dim MySTR As String
MySTR = "" Do Until MySTR = "" MsgBox "Hello" MySTR = "" Loop End Sub '------------------------------------ Sub 実験03() Dim MySTR As String
MySTR = "" Do MsgBox "Hello" MySTR = "" Loop While MySTR <> "" End Sub '------------------------------------ Sub 実験04() Dim MySTR As String
MySTR = "" Do MsgBox "Hello" MySTR = "" Loop Until MySTR = "" End Sub '------------------------------------
Do While FileName <> "" 〜〜〜〜〜〜〜 Loop
つまり、↑のようであれば、始めの部分で【「FileName」が「""」で無い場合】のみループの中身を実行することになっているので、「FileName」が「""」であれば【ループの中身は一度も実行されない】ことになります。
よって、この部分で疑問を持たないとダメです。
(ステップ実行していたら、「Do While 〜〜」の次に、ループの中身に入らずにLoopの次にいっちゃってましたよね?)
また、実験02のように、【「FileName」が「""」になるまで繰り返しなさい】としても、初めから""なのですから、【ループの中身は一度も実行されない】です。
これに比べて実験03、実験04では、ループの終わりで判定しているので、【最低1回はループの中身を無条件で実行】します。
しかし、今回のケースでは、「FileName」を開こうとしているのですからそこで""なんていうファイルパスを開こうとしても失敗しますよね。
したがって、判定の位置を変えれば済む話でもありません。
■5
では、なんで「FileName」の中身が「""」になってしまったかというと
FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
や
With Application.FileDialog(msoFileDialogFolderPicker) folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納 End With FileName = Dir(folderPath & "\*.xlsx")
では、例えば「 Dir("C:\Work\*.xlsx")」のようにきちんと、「C:\Work」というフォルダの中にある「.xlsx」という拡張子のついたファイルを探しなさい」という命令になっているのに対して、
↓では、「C:\Work\hogehoge.xlsx」というフォルダの中にある「.xlsx」という拡張子のついたファイルを探しなさい」という命令になっています
With Application.FileDialog(msoFileDialogFilePicker) folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納 End With FileName = Dir(folderPath & "\*.xlsx")
まぁ普通は「C:\Work\hogehoge.xlsx」なんていう【フォルダ】は存在しないので、当然そのフォルダの中に「.xlsx」という拡張子のついたファイルもあるわけないので、Excel君は無いよという意味で「""」と答えたわけです。
よって、まず直すべきは↓だったわけです。
Application.FileDialog(msoFileDialogFolderPicker) ←フォルダを選択してもらうダイアログ ~~~~~~~~~~~~~~~~~~~~~~~~~ Application.FileDialog(msoFileDialogFilePicker) ←ファイルを選択してもらうダイアログ ~~~~~~~~~~~~~~~~~~~~~~~
まだほかにも気になるところはありますが、こちらのトピックの■番外で書いたようにお互い不快になってもよくないので、続きはお返事をいただいてからにします。
(もこな2) 2021/11/26(金) 20:38
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.