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

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

ただいまの
回答率

89.10%

VBA フォルダ内ループの方法

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 3,538

cat_junko

score 44

ファルダ内ループについて教えてください。
グラフファイル@8ファイル”最大値”シートを、「計測内容」と言うファイルの”変位最大値”
へ書込みをしようとしています。 

そのうちの一つについては、書込み成功しました。
----------------------------------------------------------------
Sub Book_Data_Copy2()
 Dim wb_A As Workbook, wb_B As Workbook
 Dim ws_A_HeniIchiran As Worksheet, ws_B_Saidai As Worksheet

 '使用するブック、シートを変数に設定する。
Set wb_A = ActiveWorkbook '計測内容ファイル
Set wb_B = Workbooks.Open("C:\\○良1908-11グラフ.xlsm") '最終的には、フォルダループしたい
Set ws_A_HeniIchiran = wb_A.Worksheets("変位一覧表")
Set ws_B_Saidai = wb_B.Worksheets("最大値")

 'グラフからコピー
ws_B_Saidai.Activate '最大値をActiveにする
Range("I4:K5").Select '最大値の最初の項目が入っているセルを選択。ここは、全ファイル共通
Selection.Copy

 '計測内容ファイルにペースト
wb_A.Activate '計測内容ファイルに移って
ws_A_HeniIchiran.Activate '変位一覧表シートをActivate
 Range("C7").Select '変位量Xが入っているセルを選択。
ここは、ファイルが順番通り開く前提で+2づつ増やす。
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False

 wb_B.Activate '元のブックに戻る
Range("J3").Select
 ActiveWorkbook.Save
 wb_A.Activate '元のブックに戻る
Range("J3").Select
 ActiveWorkbook.Save

 'グラフからコピー
ws_B_Saidai.Activate '最大値をActiveにする
Range("L4:M5").Select '変位量Z-XとZ-Yが入っているセルまとめて選択。ここは、全ファイル共通
Application.CutCopyMode = False
 Selection.Copy

 '計測内容ファイルにペースト
wb_A.Activate '計測内容ファイルに移って
ws_A_HeniIchiran.Activate '変位一覧表シートをActivate
 Range("F7:G8").Select '変位量Z-XとZ-Yが入っているセルまとめて選択。ここは、ファイルが順番通り開く前提で+2づつ増やす。
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False


 wb_B.Activate '元のブックに戻る
Range("J3").Select
 ActiveWorkbook.Save
 ActiveWorkbook.Close
 wb_A.Activate '元のブックに戻る
Range("H3").Select
 ActiveWorkbook.Save
 End Sub
 ---------------------------------------------------------------------------

ただ、このままだとあまりいいプログラムとは思えないのでアドバイスもお願いします。
そして、フォルダ内を、ループする方法もご教示願います

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

0

こんにちは。

フォルダ内の処理について、既に回答で頂いているDir関数で目的の機能を実現できると思います。
対象のフォルダにExcel以外のファイルも存在しうるなら、以下のように拡張子まで書く等をします。
fileName = Dir("c:\TargetFolder\*.xlsm")

後、少し気になった点がActivateSelectを使っている所でした。
質問で頂いている内容からすると対話的に処理を進めるのではなく、VBA内で順々に処理を進めていくように思えました。このような場合は、ActivateSelectを使わない手段があるなら避けた方が良いと考えています。

理由は、「アクティブなブックを閉じる」や「選択されたセルをコピーする」で利用されていると思いますが、OSやExcelが高負荷になっている際などで「期待するブックがアクティブでない」や「期待するセルが選択されていない」状況(タイミングの問題などで期待と異なる状態)発生の可能性が考えられるからです。(多くの場合、そうならないとは思いますが…)
# 繰り返しの中で"状態に依存"する書き方は避けた方が良いと思います。
# ブックを閉じる際にアクティブにするのは、単純に冗長と言えるかも知れません。


例えば、以下はブックB(wb_B)からブックA(wb_A)へ指定範囲の内容をコピーペーストし、ブックBを閉じます。
# コピーペーストはSelectionでなく、RangeのCopyやPaste(Special)を利用
# ブックを閉じるのは、直接のWorkbookオブジェクトのCloseを利用
Dim CopyRng As Range  'コピー元の範囲
Dim PasteRng As Range 'ペースト先の位置

' コピー元の範囲、ペースト先の位置を設定
Set CopyRng = wb_B.Worksheets.Item("最大値").Range("I4:K5")
Set PasteRng = wb_A.Worksheets.Item("変位一覧表").Cells(1,1) '←仮にA1セル

'コピーペースト
CopyRng.Copy
PasteRng.PasteSpecial Paste:=xlPasteValues 'ほか必要に応じてオプション指定

'ブックBを閉じる
wb_B.Close()
Set wb_B = Nothing
ざっくりした書き方になっていますが、後はループの中に組み込んで、想定できるエラーへの対処を追加すると良いと思います。
・"最大値"という名前のシートが存在しない可能性の有無

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2015/11/18 12:05

    Excel以外のファイルや"最大値"シートが存在しない場合の対策であれば
    さわり部分ですが…

    (a)Excel以外のファイルを排除
     Dir("c:\TargetFolder\*.xlsm")のようにすると良さそうです。
     # xlsファイル(旧形式)とxlsmが混在する場合は少し考えないといけないですが

    (b)最大値シートが存在しない
     関数の先頭に「On Error Resume Next」を書いて
     例えば、以下のように書くと判別できます。
     -----
     Err.Clear
     Set ws_Saidai = wb_B.Worksheets.Item("最大値")
     If Err.Number = 0 Then
      '最大値が存在する
     Else
      '最大値が存在しない
      '実際にはErr.Numberに9が入る事が考えられますが、
      'そこまで厳密に見なくても良いと思います。
     End If
     -----
     # 後は、最大値シートが無いブックのファイル名をメッセージボックス等で知らせてあげると親切かなと思います。

    何かあれば、新規質問やコメント等頂ければと思います。

    キャンセル

  • 2015/11/18 14:29

    sgr-2さん
    コメント書いたつもりが・・・。
    上記、追加情報ありがとうございます。
    また、メッセージボックスの載せ方等もご教示いただけないでしょうか?
    そして、新たな質問が別件で出てきてしまったのでつい先ほど質問も立てました。
    宜しくお願い致します。

    キャンセル

  • 2015/11/18 15:01

    cat_junkoさん
    メッセージボックスの表示は「MsgBox関数」があります。

    MsgBox "メッセージ", vbOKOnly, "タイトル"
    のような書き方で使う事が出来ます。

    プログラムの処理と絡めて考えると、以下のような形をイメージしていました
    -----
    Dim errMsg As String
    errMsg = ""

    Do While (...)
    If Err.Number <> 0 Then
    '最大値のシートが存在しない
    errMsg = errMsg + vlFileName + "には「最大値」シートが存在しません" + Chr(10)
    Else
    '最大値のシートが存在する
    End If
    Loop

    MsgBox errMsg, vbOKOnly, "メッセージ"
    -----
    # メッセージボックスは多くの情報を載せる手段としてはスマートでないので、多いと思ったらメッセージボックス自体に表示する内容は簡潔なもの(省略)した方が良いと考えています。(多い少ないの明確な線引きは?と言われると辛いですが…)

    キャンセル

0

Dir関数を使えばフォルダにあるファイルを列挙できます

ループの概念が理解できないうちは、作業用のワークシートにファイルの一覧を書き出してからそれを順番に処理していくようなコードを書くことをおすすめします
処理途中の一時的な情報や、処理結果等もその作業用のワークシートに都度書き出す様にしておけば、何ができて、何ができなかったかもわかるようになります

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2015/11/16 12:18 編集

    作業用ファイルに、書き出してからそれを順番に書き出すというのの具体的なコードが知りたいです。
    宜しくお願いします。

    書き出すとこまでは、出来ました。

    キャンセル

  • 2015/11/18 08:46

    dojikkoさん
    アドバイスありがとうございました。
    なんとか、Dir関数でのループを完成させることができました。
    これから、少しづつもっと理解できるよう勉強していきたいと思います。
    また、宜しくお願い致します。

    キャンセル

0

    Dim vlFileName As String
    Dim vlIndex As Long
    
    vlFileName = Dir("c:\temp\")
    vlIndex = 1
    
    Do While (vlFileName <> vbNullString)
        Me.Range("A" & vlIndex) = vlFileName
        vlIndex = vlIndex + 1
        vlFileName = Dir
    Loop
dojikkoさんが言うようにシートにファイル名の一覧を出すといいと思いますよ
上記の場合は、「c:\temp\」の中にあるファイルを列挙します。

--追記--
Set wb_B = Workbooks.Open("C:\\○良1908-11グラフ.xlsm") '最終的には、フォルダループしたい 
ここをループして複数のシートを処理したいと思いますので、これの前に処理を追加して

    Dim vlFileName As String

    vlFileName = Dir("c:\temp\")
    
    Do While (vlFileName <> vbNullString)
       
        Set wb_B = Workbooks.Open("C:\\" & vlFileName) 
        ~以下処理~

        wb_B.close() 
        vlFileName = Dir
    Loop
こんな感じでループすればよいと思いますよ。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2015/11/17 19:29

    sgr-2さん
    本当ですね閉じてますね
    あまり見て無かったです。

    キャンセル

  • 2015/11/17 19:59

    sgr-2さん
    ForNextを、使ったからいけなかったんですね…💧
    確かに、これではForNextは回るけど肝心のDoLoopが無意味になっていました。
    明日、練り直しします。

    trickさん
    度々、すいません。
    明日、再度修正してみます。
    そして、アドバイス宜しくお願いします。

    キャンセル

  • 2015/11/18 08:43

    trickさん
    sgr-2さん

    (コードは、上に貼り付けてしまいました・・・)

    たくさんのアドバイスありがとうございました。
    また、改善案等あればアドバイスを頂けると嬉しく思います。
    宜しくお願い致します。

    キャンセル

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

  • ただいまの回答率 89.10%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる