Vbaで書式のみ高速コピペ

Question

Vbaで書式のみ高速コピ ぺする方法を教えてください
例えば一行目の書式をコピーして、五行目から十行目に貼り付けるということは
Selection.pasteでできるのですが、
大量に実行する場合、遅くて使い物にならず、困っています。
よろしくお願いします。

Comments

[hatena19]

現状のコードを提示してください。

[baklava]

ありがとうございます。

Dim wb as Workbook
dim iMinHRow as long 'ペースト先の一番上の行、別途取得。
dim lRow as long　'ペースト先の一番下の行、別途取得。

Set wb = Workbooks.Open(ファイルパス)
Debug.Print "start " & Now
For m = 0 To UBound(strASub)
strA = Split(Replace(strASub(m),":", ""), "$")
iMinCol =AlphaToNum(strA(1))
iMaxCol =AlphaToNum(strA(3))
wb.Sheets("Sheet1").Range("$" & strA(1) & "$" & strA(2) & ":$" &
strA(3) & "$" & strA(4)).Copy
wb.Sheets("Sheet1").Range(strA(1) & iMinHRow & ":" & strA(3) &
lRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
wb.Sheets("Sheet1").Range("A1").Select
Next
Debug.Print "end " & Now

strASubという配列の中に
$C$2:$E$15
$F$2:$F$15
$G$2:$J$15
$K$2:$L$15
などと、複数の範囲が文字列で格納されているので、範囲ごとに書式コピペしているという動きです。
一部selectを外して改善されたのですが、これでも範囲により2秒かかることがあります。
コピペ対象のファイルが300くらいあることがあるので、なんとかならんかなと思っているところです。
AlphaToNumは自作の別関数ですが、ここは時間かかっていません。

[hatena19]

質問は編集できますので、コードは質問に追記してください。その場合、コードはコードブロックにしてください。コード部分を選択して、ツールバーの <code>をクリックするとコードブロックになります。

Answer 1

Sub test()
    Dim wb As Workbook
    Dim rngFrom As Range
    Dim rngTo As Range
    Dim t

    t = Timer

    Set wb = Workbooks.Open(ファイルパス)
    With wb.Sheets(1)
        Set rngFrom = .Range("C1:E5")
        Set rngTo = .Range("C2:L15")
    end with

    rngFrom.Copy
    rngTo.PasteSpecial Paste:=xlPasteFormats

　　wb.close true
        
    Debug.Print "end", Timer - t & " 秒"
End Sub

とりあえず、こんな感じでいいのでは？

コピー元とコピー先の関係がよくわからないですが、
なんで、コピー先が細かく分かれているのでしょう？
あと、セルアドレスの$はあってもなくても影響がないので、
無理にばらしたり、無理にくっつけたりはしなくてもいいかと。

Answer 2

取り扱うデータが、どのようなデータなのか、質問からは読み取れませんが、
大量データに対して、コピペをForステートメントなどの繰り返し文で行うのは、
良くない手法だと思います。

Excelには便利な機能を豊富に準備しています。
オートフィルタや並べ替えを組み合わせて使用する方法もあります。
条件付き書式設定も使えると思います。

おそらく、ＣＳＶファイルだと思います。
データの取得の機能で、データをリンクすることが可能です。

今のExcelの機能は本当に充実しています。
機能で求められる結果がでる場合も多々あります。

Answer 3

高速化には、まずは、描画を停止する。

Application.ScreenUpdating = False ' 描画を停止する

'高速化したい処理

Application.ScreenUpdating = True  ' 描画を再開する

次に、無駄なSelectはしない。

Range(”A1:C1”).Select
Selection.Copy
Range(”A5:C10”).Select
Selection.PasteSpecial Paste:=xlPasteFormats 

Range(”A1:C1”).Copy
Range(”A5:C10”).PasteSpecial Paste:=xlPasteFormats 

上記の対策をしても改善されない場合は、現状のコードを提示してください。