フォルダ内に複数ある全エクセルの全シートに
共通の処理を行いたいと思っています。
下記のサイトに記載の処理を、
https://iamai101.hatenadiary.com/entry/2012/05/16/131255
下記のサイト記載のコードを用いて
全ファイル分繰り返したいと思っています。
https://rouxchan.com/dir-function/
それぞれであれば問題なく動かせるのですが、
うまく組み合わせられません。
ヒントだけでも良いのでご教示いただけましたら幸いです。
気になる質問をクリップする
クリップした質問は、後からいつでもMYページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
下記のような質問は推奨されていません。
- 質問になっていない投稿
- スパムや攻撃的な表現を用いた投稿
適切な質問に修正を依頼しましょう。
また依頼した内容が修正された場合は、修正依頼を取り消すようにしましょう。
回答1件
0
ベストアンサー
全ファイル分繰り返しのコード内の「実行させたい処理」のところで「全シート繰り返し」をCallすればいいでしょう。
vba
1Sub Sample1() 2 Dim filepath As String, cnt As Long '変数の宣言 3 Const folderpath As String = "/Users/○○/Desktop/Sample/" '定数の宣言 4 filepath = Dir(folderpath & "*.*") 'dir関数でフォルダの中のファイル名を返します 5 Do While filepath <> "" '変数に空白が入るまで処理を繰り返す 6 Workbooks.Open (folderpath & filepath) 'ワークブックを開いていく 7'--------実行させたい処理--------- 8 9 Call 全シート繰り返し 10 11'--------実行させたい処理--------- 12 Workbooks(filepath).Close SaveChanges:=True 13 '変数にまだ入力されていないファイル名を格納する 14 filepath = Dir() 15 Loop 'Do While に戻る 16End Sub 17 18Sub 全シート繰り返し() 19 20 Application.ScreenUpdating = False 21 Dim Sht As Worksheet 22 For Each Sht In Worksheets 23 Sht.Select 24 Call 値貼り付け 25 Next Sht 26 Application.ScreenUpdating = True 27End Sub 28 29Sub 値貼り付け() 30 Cells.Select 31 Selection.Copy 32 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 33 :=False, Transpose:=False 34End Sub
追記
ーーー
上記コードの改良版
vba
1Sub Sample1() 2 Dim filepath As String '変数の宣言 3 Const folderpath As String = "C:\Test\BookLoopTest\" '定数の宣言 4 filepath = Dir(folderpath & "*.xls*") 'dir関数でフォルダの中のファイル名を返します 5 Application.ScreenUpdating = False 6 7 Dim wb As Workbook 8 Do While filepath <> "" '変数に空白が入るまで処理を繰り返す 9 Set wb = Workbooks.Open(folderpath & filepath) 'ワークブックを開いていく 10 11 Call 全シート繰り返し(wb) 12 13 Workbooks(filepath).Close SaveChanges:=True 14 '変数にまだ入力されていないファイル名を格納する 15 filepath = Dir() 16 Loop 'Do While に戻る 17 Application.ScreenUpdating = True 18End Sub 19 20Sub 全シート繰り返し(wb As Workbook) 21 22 Dim Sht As Worksheet 23 For Each Sht In wb.Worksheets 24 Call 値貼り付け(Sht) 25 Next Sht 26End Sub 27 28Sub 値貼り付け(Sht As Worksheet) 29 With Sht.UsedRange 30 .Value = .Value 31 End With 32End Sub
投稿2023/06/07 13:03
編集2023/06/07 14:25総合スコア33102
あなたの回答
tips
太字
斜体
打ち消し線
見出し
引用テキストの挿入
コードの挿入
リンクの挿入
リストの挿入
番号リストの挿入
表の挿入
水平線の挿入
プレビュー
質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。
下記のような回答は推奨されていません。
このような回答には修正を依頼しましょう。
また依頼した内容が修正された場合は、修正依頼を取り消すようにしましょう。
2023/06/07 13:48