Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2016)
カット&ペースト高速化したいです
投稿日時: 20/11/12 12:17:09
投稿者: ip8bk

下記にMacro1とMacro2の2つのコードがあります。
どちらも100回カット&ペーストを繰り返しています。
 
Macro1は0.7秒、Macro2は2.9秒かかっています。
 
もう少し早くしたいのですが、どのように変更したらよいでしょうか?
ご指導ご鞭撻よろしくお願いいたします。
 
 
 

Option Explicit
Sub Macro1()
    
    Dim stime As Single, time1 As Single
    Dim i As Long

    stime = Timer
        For i = 1 To 100
            Range(Cells(1, 2), Cells(4, 3)) = ""
            Range(Cells(2, 2), Cells(4, 3)) = 1
            Range("B1:C1").Delete Shift:=xlUp
        Next i
    time1 = Format(time1 + Timer - stime, "0.0")
    Debug.Print time1 & "("; Now; ")"
    
End Sub

Sub Macro2()

    Dim stime As Single, time1 As Single
    Dim i As Long

    stime = Timer
        For i = 1 To 100
            Range(Cells(1, 2), Cells(4, 3)) = ""
            Range(Cells(2, 2), Cells(4, 3)) = 1
            Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut Range(Cells(1, 2), Cells(3, 3))
        Next i
    time1 = Format(time1 + Timer - stime, "0.0")
    Debug.Print time1 & "("; Now; ")"
    
End Sub

回答
投稿日時: 20/11/12 12:27:02
投稿者: mattuwan44

えっと、、、
コードを読んでも、
「やりたいこと」がわかりません。
日本語でやりたい手順を説明してください。
 
よくわからんけど、100回繰り返さなくても1回で出来ないかをまず考えてはいかがでしょうか?
 

投稿日時: 20/11/12 12:33:04
投稿者: ip8bk

説明不足ですみません。
テストコードで、100回の繰り返した場合の速度を計測しています。(実際にはそんなに多くないですが、コードの違いをわかりやすくするために回数を増やしています。)
 
セルの上に空白があった場合、その空白を削除して上方向にシフトすることを繰り返し行っています。

回答
投稿日時: 20/11/12 16:22:44
投稿者: sk

引用:
カット&ペースト高速化

引用:
stime = Timer
    For i = 1 To 100
        Range(Cells(1, 2), Cells(4, 3)) = ""
        Range(Cells(2, 2), Cells(4, 3)) = 1
        Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut Range(Cells(1, 2), Cells(3, 3))
    Next i
time1 = Format(time1 + Timer - stime, "0.0")

stime = Timer
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For i = 1 To 100
        Range(Cells(1, 2), Cells(4, 3)) = ""
        Range(Cells(2, 2), Cells(4, 3)) = 1
        Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut Range(Cells(1, 2), Cells(3, 3))
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
time1 = Format(time1 + Timer - stime, "0.000")
 
------------------------------------------------------------
 
・セルの再計算方式を一時的に手動方式にする。
 
・画面表示の更新を一時的に無効にする。
 
・イベントの発生を一時的に無効にする。
 
必要に応じて以上のいずれかを行なって下さい。

回答
投稿日時: 20/11/12 18:11:37
投稿者: Suzu

当方のテスト結果 Macro1は0.2秒、Macro2は0.6秒 でした。
 
違いとしては、セルの削除 / セルのコピペ ですよね。
 
推測ですが、
Delete の場合、内部処理としては、(B1:C1)データの破棄とセルのアドレスの書き換え
Cut/Paste の場合は、内容を一度メモリーに保存し それを書き込む
 
の動作なので、処理は速いのではないでしょうか。
 
であれば、早くしたいなら、処理は削除を選べば良いと思います。
 
 
以下 速度に大きくは寄与しない話かもしれませんが
 
Range(Cells(1, 2), Cells(4, 3)) = "" B1:C4 を "" とする
Range(Cells(2, 2), Cells(4, 3)) = 1 B2:C4 を 1 とする
 
Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut Range(Cells(1, 2), Cells(3, 3))
B2 と C2より下のセルの値の入っているセル を B1:C3 に貼り付ける
ですよね。
最初の2処理は、B2:C4 範囲 に対し 2回の書き込みを行っています。
Range(Cells(1,2))=""
Range(Cells(2, 2), Cells(4, 3))
の様に、1行目は、B1のみに "" を渡し、2行目では、B2:C4 に1 を渡す の方が効率的と思います。
 
3行目では、Cutしたセルを貼り付けるセルを B1:C3 (3行2列)と指定しています。
この場合、Cut対象となる セル範囲の大きさと 合致しなければなりません。
であれば、先頭セルが B2 と決まっているのですから、終端セルはC4 でなければなりません。
にも関わらず、End(xlDown) を使用しています。
 
対象のデータが C5 は必ず「空白」と決まっているのであれば構いませんが
そうで無いなら、エラーが発生しうるコードであり、通常は書かないコードです。
 
上記2点は、説明無しに提示されてしまうと、
何を目的にしたコードなのだろう と 不思議に思ってしまいます。
 
 
Range(Cells(2,2),Cells(4,3)) よりは、
Range("B2:C4") の方が オーバーヘッドがない分、速度的に有利かな と思い
テストしてみましたが当方環境では実感できるほどの差は出ませんでした。
 
PCスペックが低いのであれば、テストをしてみる価値はあると思います。

回答
投稿日時: 20/11/12 18:27:34
投稿者: mattuwan44

 >セルの上に空白があった場合、その空白を削除して上方向にシフトすることを繰り返し行っています。
 
再度書きます。
やっていることは、コードで分かりますが、
やりたいことは、コードではわかりません。
 
例えば、シート上にたくさんのデータがあるとして、
例えば各行のB列とC列が空白の行を行削除したいということですか?
 
いま、Macro1でやっているのは、
1)特定のセル範囲をクリア
2)1行空けて、テストデータ(?)入力
3)1行目を削除
 
ですよね?
書き直すとしたら、
 

Sub Macro1_001()
    
    Dim stime As Single
    Dim i As Long

    stime = Timer
        For i = 1 To 100
            With Range("B1:C4")
                .ClearContents
                Intersect(.Cells, .Offset(1)).Value = 1
                .Rows(1).Delete Shift:=xlUp
            End With
        Next
        
    Debug.Print Timer - stime & "秒"
End Sub

 
5000回くらいループしたら違いが出るかも知れないくらいの差ですね^^;
でもこれでは、「Deleteが遅い」を改善したことにはなりませんね。
Deleteの回数が1回になれば、改善すると思いますが、
シート上がどのようになっていることを想定しているのか判断できかねます。
 

回答
投稿日時: 20/11/14 10:55:56
投稿者: WinArrow
投稿者のウェブサイトに移動

Macro2の方が処理時間かかる理由
 
>Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut
この部分のセル範囲を確認してみましょう
 
Debug.Print Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Address
 
原因は、セル範囲の指定の仕方にあると思います。
 
 
 

回答
投稿日時: 20/11/16 09:58:28
投稿者: Suzu

WinArrow さんの引用:
Macro2の方が処理時間かかる理由
 
>Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut
この部分のセル範囲を確認してみましょう
 
Debug.Print Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Address
 
原因は、セル範囲の指定の仕方にあると思います。

 
WinArrowさん
すみません、上記の意図をお教え頂きたいのです。
 
Cells(2, 3).End(xlDown) の部分で、
5行目以下にも値があった場合 範囲が広くなるという事を仰りたいのでしょうか?
 
質問者さんのコードは
引用:
Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut Range(Cells(1, 2), Cells(3, 3))

Cutメソッド の Destination引数に Rangeが指定してある場合、
CutされるRane範囲が、貼付先のRange範囲 より大きい場合
 
実行時エラー '1004'
切り取り領域と貼り付け領域のサイズが違うため、貼り付けることができません
 
と表示されます。
 
直前にて、Range(Cells(2, 2), Cells(4, 3)) = 1 があるので
範囲は大きくても、B2:C4 しか無いと思っています。
 
ですので範囲が広くなる事は無いのかなと思います。
 
意図が別の所におありでしたら、ご教示ください。

回答
投稿日時: 20/11/16 10:51:02
投稿者: WinArrow
投稿者のウェブサイトに移動

Suzu さん
 
ご指摘ありがとうございます。
単純に、元セル範囲が大きくなると思っていました。
 

回答
投稿日時: 20/11/16 15:28:37
投稿者: Suzu

WinArrow さん
 
回答ありがとうございました。
 
 
質問者の方がみえられなくなったので、
このコードがどんな目的から作成されているのか、はっきり判らないのですが、
 

引用:
セルの上に空白があった場合、その空白を削除して上方向にシフトすることを繰り返し行っています。

 
テストが目的ではなく、上記が目的なのであれば
 
【不要な空白セルを一括で削除する】
https://www.moug.net/tech/exopr/0030089.html
のジャンプが使用できますから
 
Range("B1:C" & ActiveSheet.Rows.Count).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
 
で済む話ですね。

回答
投稿日時: 20/11/17 19:36:11
投稿者: mattuwan44

返事がないですね。。。
 
頭の体操で実験してみたです。
 
Macro2、こちらでは0.8秒くらいでした。

Sub Macro2_1()
    Dim i As Long
    Dim t
    
    t = Timer
    
    For i = 1 To 100
        With Range("B1:C4")
            Intersect(.Cells, .Offset(1)).Value = 1
            .Rows(1).Cut
            .Rows(.Rows.Count + 1).Insert
            .ClearContents
        End With
    Next
    
    Debug.Print Timer - t
End Sub

データの方じゃなくて空白の方を移動しちゃえばと思って試してみました。
Insertする分が余分にかかるので、1.6秒と倍になりました^^;;
 
データの配置を見た目で移動できればよいのなら、並び替えもそういう動作ですよね?
Sub Macro2_2()
    Dim i As Long
    Dim t
    
    t = Timer
    
    For i = 1 To 100
        With Range("B1:C4")
            Intersect(.Cells, .Offset(1)).Value = 1
            .Sort .Cells(1)
            .ClearContents
        End With
    Next
    
    Debug.Print Timer - t
End Sub

 
0.3秒と半分で行けそうです。
表の中から空白を排除したいなら並び替えが一番早いかと思います。
あとは、その機能の使い方次第かなぁ。。。。

投稿日時: 20/11/19 12:03:00
投稿者: ip8bk

皆様ご返信ありがとうございます。
返信遅れてすみません。
通知にチェックを入れ忘れてこんなにお返事が来ているとは知りませんでした。
 
 

【不要な空白セルを一括で削除する】 
https://www.moug.net/tech/exopr/0030089.html 
のジャンプが使用できますから 
 
Range("B1:C" & ActiveSheet.Rows.Count).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 

 
このコードは簡潔でとてもわかりやすいですね。
とても勉強になりました。
 
 
 
引用:
Sub Macro2_2()
    Dim i As Long
    Dim t
     
    t = Timer
     
    For i = 1 To 100
        With Range("B1:C4")
            Intersect(.Cells, .Offset(1)).Value = 1
            .Sort .Cells(1)
            .ClearContents
        End With
    Next
     
    Debug.Print Timer - t
End Sub

 
引用:
.Sort .Cells(1)

 
Cellsのかっこの中の1はどのような意味なのでしょうか?
私のPCでは他の数字を入れても同じ動作になります。
 

回答
投稿日時: 20/11/19 18:22:25
投稿者: mattuwan44

引用:
Cellsのかっこの中の1はどのような意味なのでしょうか?
私のPCでは他の数字を入れても同じ動作になります

 
その「1」は、
「1番目」の意味です。
 
Msgbox Range("B1:C4").Cells(1).address
 
とか、
 
Range("B1:C4").Cells(1).select
 
とかやってみて確認してみてはいかがでしょうか?
 
Range("B1:C4").Cells(1,1)
Range("B1:C4").Range("A1")
 
でも同じセルを示します。
実験なので横着しました。
 
Range("B1:C4").Cells
 
と書いたときのCellsは親オブジェクトのセルの集まりの全てを返します。
日本語で書くと、
 
セル範囲「B1からC4」のセルの集まり
 
というような表現になるでしょうか。
その集まりのうちの「1番目」(結局一番左上になります)を示したかったら、
Range("B1:C4").Cells.Item(1)
とVBAでは書きます。
が、この時のItemプロパティの表記は省略できることになってますので、
Range("B1:C4").Cells(1)
と書くことができます。
Rows(1)

Worksheets(1)
なども同様な意味になります。
 
ちなみに、
Range("B1:C4").Cells(10).Select
とやるとどこのセルが選択されるでしょうか?
セル範囲には8個しかセルがないのに、
10番目を指定したらエラーでしょうか?
そんなことを実験して自分で調べられるようになれるといいと思います。
 
 
 

回答
投稿日時: 20/11/19 18:43:54
投稿者: mattuwan44

Option Explicit

'1行毎削除してみる
Sub test001()
    Dim c As Range
    Dim t
    
    t = Timer
    
    For Each c In Range("B1:C1").Resize(1000).Rows
        c.Delete
    Next
    
    MsgBox Timer - t
End Sub

'削除を1回にする
Sub test002()
    Dim c As Range
    Dim t
    
    t = Timer

    Range("B1:C1").Resize(1000).Delete shift:=xlShiftUp
    
    MsgBox Timer - t
End Sub

 
test001は0.7秒
test002は0.07秒
 
僕が言いたかったのはこういうことです。
表中の飛び飛びの空白を検索するなら、
SpecialCells
が使え、1度で消せます。
ただし、飛び飛びの数に制限があるかもです。(ないかもです。)
並び替えを使うと削除を1回もしないのでさらに速いかと。
並び替えを使って削除したいものを集めても、1度で削除できます。
たぶん飛び飛びより速いかと思われます。興味があれば実験してみてください。
速くなれば、一旦空白を集めて削除し、元の並びに戻してもいいかと思います。
行の順番戻せるように連番を振る必要がありますが。。。。
それらは、すべて状況でどの方法がよいか違ってきますよね?
なので、想定される場面を確実にしていただきたかったです。
 
ということで、
VBAでループ処理を書かないことが高速化につながるということです。
(裏ではループ処理をしていると思われるが、それはエクセル君にお任せしましょう)

投稿日時: 20/11/20 12:23:44
投稿者: ip8bk

ご回答ありがとうございます。
一気に削除する方法も検討したいのですが、下記のコードではB1からC1000の範囲がすべて削除されてしまうのではないでしょうか?
 

引用:
Sub test002()
    Dim c As Range
    Dim t
     
    t = Timer
 
    Range("B1:C1").Resize(1000).Delete shift:=xlShiftUp
     
    MsgBox Timer - t
End Sub

 

投稿日時: 20/11/20 12:29:41
投稿者: ip8bk

ご回答ありがとうございます。
 
 

引用:
.Sort .Cells(1)

 
それともう一点教えていただきたいのですが、.cellsのドットはどのような意味なのでしょうか?
withステートメントが効いているのでしょうか?
withステートメントを同じ行をまとめているのを見たことがないので、質問させていただきました。
 
 
引用:
その「1」は、
 「1番目」の意味です。

 
なぜ1にしたのか、が知りたかったです。
 
 
 

回答
投稿日時: 20/11/20 19:06:13
投稿者: mattuwan44

>一気に削除する方法も検討したいのですが、
>下記のコードではB1からC1000の範囲がすべて削除されてしまうのではないでしょうか?

そうですよ?
たとえば、B1を左上としてそこから1000行×3列のデータがあり、
その中でB列に飛び飛びに存在している、セルの値が空白のセルの行を表から削除したいという場合
(C列D列は値があるものとする)、
 
B列を並び替えて空白セルを下に追いやり、B列の最終データより下の行を値クリアする。
(削除より値クリアの方が速い)
というような手順と、
 
ジャンプ機能で空白セルを検索して一括削除、
あるいはオートフィルターで空白を抽出して一括削除、
などの方法も考えられますが、
この辺はご自分で試されて得心される方がより有用かと思います。
飛び飛びの1000行を一括削除と
連なった1000行一括削除とで処理時間に差があるだろうか。。。というような、
知りたいようなどうでもいいような疑問は出てきますが。。。。。。
 
何度かそういう想定している状況の説明を求めましたと思いますが、
一向にそういう説明はないですね?
ないので、見切り発車でサンプルコードを書いてみましたが、
条件によりいろいろアプローチを変えないとだめなので、
一応の想定している状況を説明してほしかったです。
 
>.cellsのドットはどのような意味なのでしょうか?
>withステートメントが効いているのでしょうか?
>withステートメントを同じ行をまとめているのを見たことがないので、質問させていただきました。

 
Withステートメントは名前のない変数を宣言しているような感じになります。
なので、
名前がないので書きようがない → 省略しているように見える → 省略できる
というような論法が成り立ちます。
 
オブジェクト(≒操作対象)のプロパティ(属性≒設定)を取得あるいは設定するときは、
オブジェクトの後にピリオドを入れてからプロパティ名を書くことがルールなので、
ピリオド(ドットではない)は必須になります。
 
イメージ的には
 
セル範囲B1からC4セルに対して
  (その対象)「を」並び替え 並び替えの1つ目のキーは、(その対象)「の」1番目のセル
括りの終わり
 
というような感じに
「を」とか「の」の助詞がピリオドに代わります。
 
>なぜ1にしたのか、が知りたかったです。
 
なるほど、、、、
 
意味的には、
Range("B1:C4").Sort Key1:=Range("B1")
こういう意味で書いただけです。
 
キーとするセルは
B2でもC4でもB100でも、
同じ結果になると思います。
 
こういう感じでよいでしょうか?
 
この際なので、色々聞いて疑問を解消してください。
いつもPCの前に座っているわけではないので、回答は遅れ気味になるかもですが。
 
長々と乱文すみません。書いてるといろいろ考えちゃうので思いついたままに書いてると、
長くなってしまいます^^;

トピックに返信