セル幅の変更について

質問

vbaで下のように(抜粋)作ってセルに"りんご"という文字が入ってない行を表示しないようにしたいのですが、幅は０になるのですが、処理するスピードがすごく遅いのですが早くするやり方ってありますでしょうか？　(オートフィルタの抽出並みの速さって可能ですか？)
　　　　Do Until m >= 145
　　　　dt = Sheets(9).Cells(m + 4, 2).Value
If dt <> "りんご" Then
Sheets(9).Rows(m + 4).Hidden = True
Sheets(9).Rows(m + 5).Hidden = True
End If
　　　　m = m + 2
　　　　Loop
（セルは結合しているため2行消すようにしています）

回答No.2

imogasi

（１）式や画面の全体構成に影響するHidden,Insert,Deleteは処理が遅くなり勝ち。
画面更新ＳｃｒｅｅｎＵｐｄａｔｉｎｇを止めることにより速くなろう。
（２）＞＝１４５では終わりが無い（６５５３６行？）。普通最終行まで処理しなければならない場合など考えられない。
どういうロジックなんですか。無駄な処理やってない？
’－－
コードだけ書いて、ロジックを説明してないので良くわからない。我流じゃないかな。初心者は我流のコードを質問に書いて、これを直せと来るが、ロジックを適当にすると、質問の悩みが、必要ない場合が結構多いようにおもう。
やりたいことを、質問文章で説明し、ベテランの方の、ロジックを参考にして、良いものがあれば取り入れては。
状況がわからなくて、自信ないけど、別シートに「行を省いたものを新シートとして作る」ロジックを検討をお勧めします。
’－－
下記は質問者のための直の回答ではなく、テストできてないが、イメージを示すもの。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets(9)
Set sh2 = Worksheets("Sheet2")
k = 2
'--
Application.ScreenUpdating.updating = False
For m = 145 To 200 Step 2
If sh1.Cells(m + 4, "B") = "りんご" Then
'残すセル
For j = 1 To 6
sh2.Cells(k, j) = sh1.Cells(m, j)
sh2.Cells(k + 1, j) = sh1.Cells(m + 1, j)
k = k + 2
Next j
End If
Next i
Application.ScreenUpdating.updating = True
End Sub

回答No.1

ka_na_de

Application.ScreenUpdating = False
（元のコード）
Application.ScreenUpdating = True

とすれば、画面の表示切替によるロスを抑制できます。