[[20210901161731]]　『複数ブックを行き来する場合のscreenupdateing』（たらこ弱す）　ページの最後に飛ぶ

『複数ブックを行き来する場合のscreenupdateing』（たらこ弱す）

「WB1から情報をコピーし、WB2に貼り付ける」という処理を繰り返すマクロを作りました。
しかし、複数ブックを何度も行き来するためか、screenupdatingをfalseにしても画面がちらついてしまって気になります。
何かちらつきを止める良い方法はありませんでしょうか？

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

すみません、調べたところどうしようもない仕様のようですね。
失礼しました。
（たらこ弱す） 2021/09/01(水) 17:26

 参考まで。

http://officetanaka.net/excel/vba/speed/s2.htm

 内容によりますが、データの転記はコピペしなくても済む
 場合があります。
（OK） 2021/09/01(水) 17:51

 ADODB
CreateObject
GetObject
とかでもだめなのでしょうか。＾＾；
↑いくぶんましかも。。。m(_ _)m
（隠居Ｚ） 2021/09/01(水) 18:10

■１
既に案内のあるように、VBAの世界では対象のブックやシートを明示すれば、いちいちアクティブにしたり選択したりする必要はありません。

■２
＞screenupdatingをfalseにしても画面がちらついてしまって気になります。
ちょっと考えにくいですが、逐一画面抑制を解除してたらそうなるかもしれません。

■３
以上を踏まえて、現状のコードを提示してみてはどうでしょうか？
妙案が示されるかもですよ？

 （ブック名などばれてまずいのであれば、適当なものに置き換えてくださいね）

（もこな２） 2021/09/01(水) 20:47

 ScreenUpdating をFalseにしていても、複数のファイルを開いて、処理して、閉じてを繰り返すと
 ブックを開くときにチラチラと開いたブックが見えてしまう場合があったり。
　
 Applicationオブジェクトをもう一つ作って、Visible=Falseのまま裏で開くと少しマシになるかもしれません
（´・ω・`） 2021/09/01(水) 20:57

たくさんのご返信をありがとうございます。
実はフィルタをかけた場合のコピペの方法がよく分からず「マクロの記録」で作成したものを改造しました。
そのためコピペのたびにワークシートを行ったり来たりするというカッコ悪いVBAが出来上がった次第です(^^;　やっぱりファイル切り替えなくても大丈夫なはずですよね？(^^;

「管理簿」ファイルから「会計簿」ファイルへデータを転記するVBAです。
クラスが複数あるクラブにおいて、「管理簿」ファイルで全クラスの会計状況をまとめて管理しており、そこから各クラス専用の「会計簿」ファイルへ適宜データをコピペする要領です。

ーーーー

　sub 管理簿からクラスごとの会計簿へ転記 ()

　Dim a As String
　Dim b As Long
　a = Cells(1, 1).Value
　b = Cells(1, 2).Value

　Dim WB1 As Variant
　Dim WB2 As Variant
　Dim FILENAME As string
　FILENAME = Dir(a & b.xlsm")
　Set WB1 = Workbooks("管理簿.xlsm")
　Set WB2 = Workbooks(FILENAME)　'

　WB1.Activate　’以下、毎回「WB1(2).Activate」を入れないとエラーが出るため仕方なく入れています。どうにかすれば画面を切り替えなくてもできるように思うのですが・・・。
　Rows("4:4").Select

  　  Selection.AutoFilter
　Range("$A$4:$AJ$2000").AutoFilter Field:=1, Criteria1:=a
　Range("$A$4:$AJ$2000").AutoFilter Field:=2, Criteria1:=b
　Range(Cells(5, 4), Cells(Rows.Count, 4).End(xlUp)).Select 'D列の５行目～フィルタで抽出された最終行までをコピー
    Selection.Copy
　WB2.Activate
　Range("B5").Select
  　  ActiveSheet.Paste  'フィルタの仕様として、単純なコピペをすると可視セルのみ貼りつく。
　WB1.Activate
 '同様に、４月～１２月分の集金状況についてもコピペ。
 '最終セルをCells(Rows.Count, 20).End(xlUp)にすると、空欄がある場合に上手くいかないためoffsetで処理。
　Range(Cells(5, 12), Cells(Rows.Count, 4).End(xlUp).Offset(0, 16)).Select
  　  Application.CutCopyMode = False
    　Selection.Copy
　WB2.Activate
  　  Range("D5").Select
    　ActiveSheet.Paste
　WB1.Activate
  　  Range(Cells(5, 9), Cells(Rows.Count, 4).End(xlUp).Offset(0, 5)).Select '同様に、１月～３月分の集金状況についてもコピペ
   　 Application.CutCopyMode = False
    　Selection.Copy
　WB2.Activate
  　  Range("M5").Select
    　ActiveSheet.Paste
　WB1.Activate
  　  Rows("4:4").Select
    　Selection.AutoFilter 'フィルタを解除する。
    　Range(Cells(a + 4, 27), Cells(a + 4, 35)).Select '該当クラスの会費のうち４月～１２月分をコピペ（値のみ）
  　  Selection.Copy
　WB2.Activate
  　  Range("D3").Select
    　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
　        :=False, Transpose:=False
　WB1.Activate
  　  Range(Cells(a + 4, 24), Cells(a + 4, 26)).Select '同様に、１月～３月分の集金状況もコピペ（値のみ）
　    Application.CutCopyMode = False
  　  Selection.Copy
　WB2.Activate
  　  Range("M3").Select
    　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  　      :=False, Transpose:=False
　WB1.Activate
　ActiveWindow.ScrollColumn = 1 ' スクロール列の設定（一番左へ）
　ActiveWindow.ScrollRow = 1 ' スクロール行の設定（一番上へ）
　Range("A1").Select

　Workbooks(FLNAME).Close SaveChanges:=True
　MsgBox "会計簿へ情報を反映しました。"

　Application.ScreenUpdating = True

　End Sub
（たらこ弱す） 2021/09/01(水) 22:49

 こんばんは　＾＾
全部書き換えるのは大変かも。でもアクティブにするのを
止めて、withステートメントでくくり、ドットを付けて、
ブックとシートを明確に指定してあげると、処理速度は
解りませんが、少なくともチラつきは解消すると思いま
す。。。←多分。。。でも失敗すると大変な目にあうかも
しれませんので、正常に動いているのであればちらつきく
らいは我慢した方がいいかも。。。(￣▽￣)。。。＾＾；
m(_ _)m
（隠居Ｚ） 2021/09/01(水) 23:06

■４
既に述べたように、ＶＢＡの世界では基本的にブックやシートなど（オブジェクトといいます）を明示すればいちいちアクティブにしたり選択したりする必要はありません。

また、【標準モジュール】でシートの指定を省略した場合は、ActiveSheetを指定したものとして扱われるルールです。
したがって、複数のブックやシートを対象にする処理を考えるならば、きちんとブックやシートを指定（オブジェクト修飾）すべきです。

■５
提示された↓は構文エラーになります。

 FILENAME = Dir(a & b.xlsm")
 FILENAME = Dir(a & b & ".xlsm")

正しくは↑のようにすべきです。

さらにDIR関数を使ってブック名を調べているということは、そのブックは開いていないのではありませんか？ブックが開いていない場合、いきなり変数にセットできません。
ではどうするかというと、ブックを開けばよいだけです。

したがって、↓は

 Set WB2 = Workbooks(FILENAME)
 Set WB2 = Workbooks.Open(FILENAME)

↑のようにしたかったのではありませんか？

■６
実はCopyメソッドには、「引数：Destination」で貼り付け先を指定するとPasteメソッドの代わりができるといった機能があります。
割とよく使われるテクニックなので覚えておいて損は無いでしょう。

■７
PasteSpecialメソッドのうち、Operation,SkipBlanks,Transposeはすべて【規定値】が指定されています。
PasteSpecialメソッドでは、引数が省略された場合、規定値を指定したものとして扱われるルールがあるので、Operation,SkipBlanks,Transposeの指定は省略しても構いません。

■８
実はオートフィルタが設定された範囲は↓で取得可能です。

 .AutoFilter.Range

ただし、↑で取得されるのは項目行を含めた範囲です。
では、項目行を含めない範囲にしたい場合はどうすればよいかというと、単純に１行下げればokです。
１段下げることにより、余分な行が最後に加わることにはなりますが、空っぽのデータなので今回のようなケースでは大した問題ではないでしょう。
それでも気になる場合にはIntersectメソッドを使って「AutoFilter.Range」と「AutoFilter.Range.Offset(1)」が重なる範囲を取得すればよいです。

■９
ということを踏まえて、提示のコードを整理するとこんな感じになりますよね。

 ※１　シートはこちらで勝手に推測しました。試されるならご自身の環境に合わせてカスタマイズしてください。
 ※２　コンパイルエラーにならないことしかチェックしてません。ミスっていたらごめんなさい
    Sub 整理()
        Dim FILENAME As String
        Dim WB2 As Workbook

        'Application.ScreenUpdating = False 　←★これが無いと画面更新抑制をしたことにならない★
        With Workbooks("管理簿.xlsm").Worksheets(1)
            FILENAME = Dir(.Range("A1").Value & .Range("B1").Value & ".xlsm")

            Set WB2 = Workbooks.Open(FILENAME)

            .AutoFilterMode = False 'オートフィルタ強制解除
            .Rows("4:4").AutoFilter

            With .AutoFilter.Range
                .AutoFilter Field:=1, Criteria1:=.Range("A1").Value
                .AutoFilter Field:=2, Criteria1:=.Range("B1").Value

                Intersect(.Cells, .Offset(1), .Parent.Range("D:D")).Copy WB2.Worksheets(1).Range("B5")

                '同様に、４月～１２月分の集金状況についてもコピペ。
                Intersect(.Cells, .Offset(1), Parent.Range("L:T")).Copy WB2.Worksheets(1).Range("D5")

                '同様に、１月～３月分の集金状況についてもコピペ
                Intersect(.Cells, .Offset(1), Parent.Range("I:I")).Copy WB2.Worksheets(1).Range("M5")
            End With

            .AutoFilterMode = False 'オートフィルタ強制解除

             '該当クラスの会費のうち４月～１２月分をコピペ（値のみ）
            .Cells(.Range("A1").Value + 4, "AA").Resize(, 9).Copy
            WB2.worksheetsd(1).Range("D3").PasteSpecial Paste:=xlPasteValues

             '同様に、１月～３月分の集金状況もコピペ（値のみ）
             .Cells(.Range("A1").Value + 4, "X").Resize(, 3).Copy
             WB2.worksheetsd(1).Range("M3").PasteSpecial Paste:=xlPasteValues

            WB2.Close SaveChanges:=True
            MsgBox "会計簿へ情報を反映しました。"
        End With
        Application.ScreenUpdating = True
    End Sub

（もこな２） 2021/09/02(木) 02:13

コメント返信：

[ 一覧(最新更新順) ]

[[20210901161731]] 『複数ブックを行き来する場合のscreenupdateing』（たらこ弱す） ページの最後に飛ぶ

[[20210901161731]]　『複数ブックを行き来する場合のscreenupdateing』（たらこ弱す）　ページの最後に飛ぶ