スキルアップ・問題解決なら、モーグにおまかせ！

下記にMacro1とMacro2の２つのコードがあります。
どちらも１００回カット＆ペーストを繰り返しています。
 
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

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

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

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

引用:
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")

当方のテスト結果 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スペックが低いのであれば、テストをしてみる価値はあると思います。

 >セルの上に空白があった場合、その空白を削除して上方向にシフトすることを繰り返し行っています。
 
再度書きます。
やっていることは、コードで分かりますが、
やりたいことは、コードではわかりません。
 
例えば、シート上にたくさんのデータがあるとして、
例えば各行の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

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

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

引用:
Range(Cells(2, 2), Cells(2, 3).End(xlDown)).Cut Range(Cells(1, 2), Cells(3, 3))

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

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

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

返事がないですね。。。
 
頭の体操で実験してみたです。
 
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

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

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

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

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

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

ご回答ありがとうございます。
一気に削除する方法も検討したいのですが、下記のコードでは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

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

引用:
.Sort .Cells(1)

引用:
その「1」は、
 「1番目」の意味です。

＞一気に削除する方法も検討したいのですが、
＞下記のコードではB1からC1000の範囲がすべて削除されてしまうのではないでしょうか？
そうですよ？
たとえば、B1を左上としてそこから1000行×3列のデータがあり、
その中でB列に飛び飛びに存在している、セルの値が空白のセルの行を表から削除したいという場合
（C列D列は値があるものとする）、
 
B列を並び替えて空白セルを下に追いやり、B列の最終データより下の行を値クリアする。
（削除より値クリアの方が速い）
というような手順と、
 
ジャンプ機能で空白セルを検索して一括削除、
あるいはオートフィルターで空白を抽出して一括削除、
などの方法も考えられますが、
この辺はご自分で試されて得心される方がより有用かと思います。
飛び飛びの1000行を一括削除と
連なった1000行一括削除とで処理時間に差があるだろうか。。。というような、
知りたいようなどうでもいいような疑問は出てきますが。。。。。。
 
何度かそういう想定している状況の説明を求めましたと思いますが、
一向にそういう説明はないですね？
ないので、見切り発車でサンプルコードを書いてみましたが、
条件によりいろいろアプローチを変えないとだめなので、
一応の想定している状況を説明してほしかったです。
 
>.cellsのドットはどのような意味なのでしょうか？
>withステートメントが効いているのでしょうか？
>withステートメントを同じ行をまとめているのを見たことがないので、質問させていただきました。
 
Withステートメントは名前のない変数を宣言しているような感じになります。
なので、
名前がないので書きようがない　→　省略しているように見える　→　省略できる
というような論法が成り立ちます。
 
オブジェクト（≒操作対象）のプロパティ（属性≒設定）を取得あるいは設定するときは、
オブジェクトの後にピリオドを入れてからプロパティ名を書くことがルールなので、
ピリオド（ドットではない）は必須になります。
 
イメージ的には
 
セル範囲B1からC4セルに対して
　　（その対象）「を」並び替え　並び替えの1つ目のキーは、（その対象）「の」1番目のセル
括りの終わり
 
というような感じに
「を」とか「の」の助詞がピリオドに代わります。
 
＞なぜ１にしたのか、が知りたかったです。
 
なるほど、、、、
 
意味的には、
Range("B1:C4").Sort Key1:=Range("B1")
こういう意味で書いただけです。
 
キーとするセルは
B2でもC4でもB100でも、
同じ結果になると思います。
 
こういう感じでよいでしょうか？
 
この際なので、色々聞いて疑問を解消してください。
いつもPCの前に座っているわけではないので、回答は遅れ気味になるかもですが。
 
長々と乱文すみません。書いてるといろいろ考えちゃうので思いついたままに書いてると、
長くなってしまいます＾＾；

ありがとうございました。
とても勉強になりました。
時間あるときに見返そうと思い、解決が遅くなりました。(m__m)