[[20200511142731]] 『全シートに同じ内容の処理』(田中) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『全シートに同じ内容の処理』(田中)

フォルダ内全ブック、全シートに対して値複写を行いたいと思っています
下記のものだと1シートにしか対応しません
どの様にすればよろしいでしょうか?

Sub Sample()
Dim buf As String
Dim fPass as String

fPass=Thisworkbook.pass & "\フォルダ名\"
buf = Dir(fPass & "*.xls")

Do While Len(buf) > 0
Workbooks.open Filename:=fPass & buf, UpdateLinks:=0
Worksheets("Sheet1").Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(buf).save
Workbooks(buf).close
buf = Dir()
Loop

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows10 >


 この辺りとか、
https://search.yahoo.co.jp/search?p=%E3%83%9E%E3%82%AF%E3%83%AD+%E5%85%A8%E3%81%A6%E3%81%AE%E3%82%B7%E3%83%BC%E3%83%88%E3%81%AB%E9%81%A9%E7%94%A8&fr=top_ga1_sa&ei=UTF-8&ts=16521&aq=0&oq=%E3%83%9E%E3%82%AF%E3%83%AD%E3%80%80%E3%81%99%E3%81%B9%E3%81%A6%E3%81%AE%E3%81%97&at=s&ai=w6hdXBbZTbq6CfKw0A8vaA
(BJ) 2020/05/11(月) 15:17

 開いたブックに対してシートを一つずつFor Each 〜 Nextで取り出して処理します。
 全体をコピーして値で貼り付けるよりも各セルの値だけ代入した方が速いかと思いますので
 Sh.UsedRange.Value = Sh.UsedRange.Value
 で使われているセル範囲の値のみ代入しなおしています。

 ついでにApplication.ScreenUpdatingで画面の表示を止めて、ブックを開閉によるちらつきを
 なくしています。Application.DisplayAlertsで保存時の注意メッセージを止めています。

 Sub Sample2()
    Dim buf As String
    Dim fPass As String
    Dim Sh As Worksheet
    Dim WB As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    fPass = ThisWorkbook.Path & "\フォルダ名\"
    buf = Dir(fPass & "*.xls")
    Do While Len(buf) > 0
        Set WB = Workbooks.Open(Filename:=fPass & buf, UpdateLinks:=0)
        For Each Sh In WB.Sheets
            Sh.UsedRange.Value = Sh.UsedRange.Value
        Next Sh
        WB.Close 1
        buf = Dir()
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 End Sub
(助六) 2020/05/11(月) 15:58

 xlsxやxlsmは無い、でいいですか?
(OK) 2020/05/11(月) 16:00

丁寧な返信ありがとうございます。
例えばxlsxやxlsmを使う場合も出てくると思うのですが、
そういった場合はどうすればよろしいでしょうか?
(田中) 2020/05/17(日) 17:50

 助六さんのコードの

 >buf = Dir(fPass & "*.xls")

 buf = Dir(fPass & "*.xls*")

 にすればいけると思います。
(OK) 2020/05/17(日) 23:26

http://www.excel.studio-kazu.jp/kw/20200511142731.html

 「Dir関数で3文字の拡張子を指定した場合、その3文字「で始まる」拡張子が該当すると判断されます。」

 らしいです。

(通行人) 2020/05/18(月) 00:43


 これすか?

https://www.moug.net/tech/exvba/0100048.html
(OK) 2020/05/18(月) 08:03


 >「Dir関数で3文字の拡張子を指定した場合、その3文字「で始まる」拡張子が該当すると判断されます。」
 やってみましたが、ならなかったです。

 ファイルシステムがFATならありそうな話ですが、NTFSだとどうなんでしょうね。
 FATのドライブもってないのでテストできません。 

 buf = Dir(fPass & "*.xls*")
 にしておくほうが安全だと思います。
(´・ω・`) 2020/05/18(月) 09:15

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.