Excel (VBA) |
![]() ![]() |
(Windows 10 Home : Excel 2016)
カット&ペースト高速化したいです
投稿日時: 20/11/12 12:17:09
投稿者: ip8bk
|
---|---|
下記にMacro1とMacro2の2つのコードがあります。
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
|
---|---|
えっと、、、
|
![]() |
投稿日時: 20/11/12 12:33:04
投稿者: ip8bk
|
---|---|
説明不足ですみません。
|
![]() |
投稿日時: 20/11/12 16:22:44
投稿者: sk
|
---|---|
引用: 引用: 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秒 でした。
|
![]() |
投稿日時: 20/11/12 18:27:34
投稿者: mattuwan44
|
---|---|
>セルの上に空白があった場合、その空白を削除して上方向にシフトすることを繰り返し行っています。
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の方が処理時間かかる理由
|
![]() |
投稿日時: 20/11/16 09:58:28
投稿者: Suzu
|
---|---|
WinArrow さんの引用: WinArrowさん すみません、上記の意図をお教え頂きたいのです。 Cells(2, 3).End(xlDown) の部分で、 5行目以下にも値があった場合 範囲が広くなるという事を仰りたいのでしょうか? 質問者さんのコードは 引用: Cutメソッド の Destination引数に Rangeが指定してある場合、 CutされるRane範囲が、貼付先のRange範囲 より大きい場合 実行時エラー '1004' 切り取り領域と貼り付け領域のサイズが違うため、貼り付けることができません と表示されます。 直前にて、Range(Cells(2, 2), Cells(4, 3)) = 1 があるので 範囲は大きくても、B2:C4 しか無いと思っています。 ですので範囲が広くなる事は無いのかなと思います。 意図が別の所におありでしたら、ご教示ください。 |
![]() |
投稿日時: 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
|
---|---|
返事がないですね。。。
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 このコードは簡潔でとてもわかりやすいですね。 とても勉強になりました。 引用: 引用: Cellsのかっこの中の1はどのような意味なのでしょうか? 私のPCでは他の数字を入れても同じ動作になります。 |
![]() |
投稿日時: 20/11/19 18:22:25
投稿者: mattuwan44
|
---|---|
引用: その「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
|
---|---|
ご回答ありがとうございます。
引用: |
![]() |
投稿日時: 20/11/20 12:29:41
投稿者: ip8bk
|
---|---|
ご回答ありがとうございます。
引用: それともう一点教えていただきたいのですが、.cellsのドットはどのような意味なのでしょうか? withステートメントが効いているのでしょうか? withステートメントを同じ行をまとめているのを見たことがないので、質問させていただきました。 引用: なぜ1にしたのか、が知りたかったです。 |
![]() |
投稿日時: 20/11/20 19:06:13
投稿者: mattuwan44
|
---|---|
>一気に削除する方法も検討したいのですが、
|
![]() |
投稿日時: 21/01/05 12:28:02
投稿者: ip8bk
|
---|---|
ありがとうございました。
|