[[20211126122800]] 『任意のフォルダを選択し、フォルダ内にある複数の』(初心者) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『任意のフォルダを選択し、フォルダ内にある複数の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


まずは、↓から始末をつけてはいかがでしょうか?
[[20211114090213]] 『フォルダ内のエクセルを選択し、選択したエクセル』(P)
[[20211114092753]] 『条件分岐の方法』(BPA)

(もこな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


>わからん
>もこな2

ありがとうございます。
任意のフォルダを選択し、その中にある複数エクセル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


>1つのエクセルbookの受渡しで止まっております。

フォルダを選択するのではなく、ファイルを選択しているからでしょう。

最初に提示されたコードではフォルダを選択していたのに、変えてしまったのですね。

(わからん) 2021/11/26(金) 17:25


■1
>エラーは、>FileName = Dir(folderPath & "\*.xlsx")で止まっており、

既に指摘があるところですが、こういうことです。

    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


>もこな2

ありがとうございます。
はい。ステップ実行しています。
> アレレ、「FilePath」にファイルパスが入るぞ
>アレレ、「FileName」が最初から""になってしまうぞ

となるはずですが、そこで疑問に思わなかったのですか?

対処方法がわかりませんでした。

教えて頂いていますし、顔が見えないネットの世界では。
誹謗中傷はあると思っています。

(初心者) 2021/11/26(金) 19:10


> アレレ、「FilePath」にファイルパスが入るぞ
>アレレ、「FileName」が最初から""になってしまうぞ

任意で選ぶので、初期では、"”になると思っていましたので、
疑問に思いませんでした。
今でも、疑問に思わないです

(初心者) 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.