For Nextマクロの高速化についてご教示ください。

質問

エクセル2000です。

以下は、ワークシートのA列の２行目以降に赤（Interior.ColorIndex = 3 ）のセルがあればその行を非表示に、１行目のA列以降に赤いセルがあればその列を非表示にする単純なマクロです。通常はストレスなく動いてくれるのですが、あるBOOKにこのマクロを設定したら、わずか200行程度の処理に1分以上かかってしまいました。
そのBOOKは1.4MBあるのでそのせいとも思えるのですが、それにしても時間がかかりすぎるような気もします。
高速化する方法がありましたらご教示くださいませ。
(o。_。)oペコッ

Private Sub 行列非表示()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With ActiveSheet

x = .Cells(1, 1).SpecialCells(xlLastCell).Row
y = .Cells(1, 1).SpecialCells(xlLastCell).Column

For i = 2 To x
If .Cells(i, "A").Interior.ColorIndex = 3 Then
.Rows(i).Hidden = True
End If
Application.StatusBar = i
Next i
For n = 1 To y
If .Cells(1, n).Interior.ColorIndex = 3 Then
.Columns(n).Hidden = True
End If
Application.StatusBar = n
Next n
End With
Application.StatusBar = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
End Sub

回答No.2

Wendy02

こんばんは。

私には良く分からないですが、ひとつだけ、Application.StatusBar に表示するというのは、遅いという問題があるとしたら、それは余計だと思います。このマクロは、トグルになっていますので、もう一度すれば、戻ります。

'-----------------------------------

Sub 行列非表示R()
　　Dim ArI() As String
　　Dim ArN() As String
　　Dim i As Long, x As Long, y As Long, n As Long
　　Dim a As Long, b As Long, e As Long, f As Long

　　With ActiveSheet
　　　　e = .UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count
　　　　f = .UsedRange.Rows.Count
　　　　x = .Cells(1, 1).SpecialCells(xlLastCell).Row
　　　　y = .Cells(1, 1).SpecialCells(xlLastCell).Column
　　If f <= 1 And y <= 1 Then
　　　 MsgBox "現在のシートの状態ではマクロは不可能かもしれません。", 48
　　　 Exit Sub
　　End If
　　If e <> f Then
　　　'トグルになっている
　　　 .Cells.Rows.RowHeight = .StandardHeight
　　　 .Cells.Columns.ColumnWidth = .StandardWidth
　　　 Exit Sub
　　End If
　　'Main
　　Application.Calculation = xlCalculationManual
　　Application.ScreenUpdating = False
　　　　For i = 2 To x
　　　　　　If .Cells(i, 1).Interior.ColorIndex = 3 Then
　　　　　　　　ReDim Preserve ArI(a)
　　　　　　　　ArI(a) = .Cells(i, 1).Address(0, 0)
　　　　　　　　a = a + 1
　　　　　　End If
　　　　Next i
　　　　For n = 1 To y
　　　　　　If .Cells(1, n).Interior.ColorIndex = 3 Then
　　　　　　　　ReDim Preserve ArN(b)
　　　　　　　　ArN(b) = .Cells(1, n).Address(0, 0)
　　　　　　　　b = b + 1
　　　　　　End If
　　　　Next n
　　　　.Range(Join(ArI(), ",")).EntireRow.Hidden = True
　　　　.Range(Join(ArN(), ",")).EntireColumn.Hidden = True
　　End With
　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。

非表示にした行列を表示するのは、

Private Sub 行列表示()
With ActiveSheet
.Cells.EntireRow.Hidden = False
.Cells.EntireColumn.Hidden = False
End With
End Sub

で、瞬時に出来ますのでトグルにする必要はないんでが、そのままやってみたところ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」となってしまいます。
.Range(Join(ArI(), ",")).EntireRow.Hidden = True　がひっかかるようです。どこがわるいのでしょうか？

補足

ちなみにエラーになった.Range(Join(ArI(), ",")).EntireRow.Hidden = True　の、Join(ArI(), ",")の中身は、

A76,A77,A78,A79,A80,A81,A82,A83,A84,A85,A86,A87,A88,A89,A90,A91,A92,A93,A94,A95,A96,A97,A98,A99,A100,A101,A102,A103,A104,A105,A106,A107,A108,A109,A110,A111,A112,A113,A114,A115,A116,A117,A118,A119,A120,A121,A122,A123,A124,A125,A126,A127,A128,A129,A130,A131,A132,A133,A134,A135,A136,A137,A138,A139,A140,A141,A142,A143,A144,A145,A146,A147,A148,A149,A150,A151,A152,A153,A154,A155,A156,A157,A158,A159,A160,A161,A162,A163,A164,A165,A166,A167,A168,A169,A170,A171,A172,A173,A174,A175,A176,A177,A178,A179,A180,A181,A182,A185　　
でした。
多すぎるのでしょうか？