エクセル2000です。
以下は、ワークシートのA列の2行目以降に赤(Interior.ColorIndex = 3 )のセルがあればその行を非表示に、1行目の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.4
- 回答日時:
>残念ながら時間はほとんどかわりませんでした。
そうですか。では、あとコードで制御可能なのは
Application.EnableEvents の制御くらいしか思いつきません。お力になれずすみませんm(_ _)m
あとは、コードに問題があるのではなく、
その『200行程度の処理に1分以上』かかるBookの仕様に問題があるのではないか、
探ってみられると良いと思います。
新規Bookに問題のシートのセル範囲をコピーして試してみるとか、
シェイプやオブジェクトの数を調べてみるとか、
条件付き書式などの設定を調べてみるとか。
作業用Bookで、各設定を1つずつデフォルトに戻していく度に、
Private Sub 行列非表示() を実行して比較してみると、何が原因なのか解るのではないかと思います。
もしわかったら教えてくださいね。
この回答への補足
今度は、各シートを片っ端から削除してみました。
そしたらある特定のシートを削除すると、飛躍的に早くなることがわかりました。しかしそのシートには現在、なんのデータも入っていないし条件付書式やオブジェクトも配置していません。
( ̄~ ̄;)う~ん 何なんだ、これは・・・・。
とりあえず、1分以上かかったシートを別BOOKにコピーしてためしたところ瞬時に終わりました。
やはり、BOOKのサイズが大きいせいだと判断し、かたっぱしからシートをクリアしてみましたがほとんどかわりません。
ついには当該シートを含め、すべてのデータをクリアしましたがそれでも変わらないのです。
これはBOOKが壊れているのでしょうか?
No.3
- 回答日時:
こんにちは。
>そのままやってみたところ、「実行時エラー1004 アプリケーション定義またはオブジェク>ト定義のエラーです」となってしまいます。
>.Range(Join(ArI(), ",")).EntireRow.Hidden = True がひっかかるようです。どこがわるいのでしょうか?
それは、確か、引数の個数の問題だと思いますね。
調べても出てこないけれど、そんなに多くないですね。たぶん、旧VB系の引数のパラメータ配列ですと、30個ぐらいだったような気がします。
.Range(Join(ArI(), ",")).Select
もし、そうなら、これでも、エラーが発生するはずです。
そうしたら、文字列を適当な個数が来たら、そこで切って、それを、最初、文字列に置き換えていけばよいかもしれません。
If a > 20 Or i = x Then
ReDim Preserve ArR(k)
ArR(k) = Join(ArI(), ",")
k = k + 1
Erase ArI()
a = 0
End If
ArR()は、20個とか30個とか区切った単位を格納する文字列
ur は、Union Range の変数
For Each v In ArR()
If ur Is Nothing Then
Set ur = .Range(v)
Else
Set ur = Union(.Range(v), ur)
End If
Next v
この考え方は、要するに、
VBAの基本原則で、VBAの中では、セルに頻繁にアクセスしないこと。
というものがあります。一旦、配列や文字列で取得してから、一気に、セル(行・列含む)を取得すればよいわけです。
この回答への補足
1.行が途中(198行以降)は赤でも非表示になりません。
2.列のところで
For Each u In ArC() が、「実行時エラー92 Forループが初期化されていません」となってしまうコードです。
Sub test01()
Dim ArI() As String, ArN() As String, ArR() As String, ArC() As String
Dim i As Long, x As Long, y As Long, n As Long
Dim a As Long, b As Long, k As Long, j As Long
Dim ur As Range, uc As Range
Dim v, u
With ActiveSheet
x = .Cells(1, 1).SpecialCells(xlLastCell).Row
y = .Cells(1, 1).SpecialCells(xlLastCell).Column
' MsgBox x
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
If a > 20 Or i = x Then
ReDim Preserve ArR(k)
ArR(k) = Join(ArI(), ",")
k = k + 1
Erase ArI()
a = 0
End If
End If
Next i
For Each v In ArR()
If ur Is Nothing Then
Set ur = .Range(v)
Else
Set ur = Union(.Range(v), ur)
End If
Next v
ur.EntireRow.Hidden = True
Set ur = Nothing
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
If b > 20 Or n = y Then
ReDim Preserve ArC(j)
ArC(j) = Join(ArN(), ",")
j = j + 1
Erase ArN()
b = 0
End If
End If
Next n
For Each u In ArC() 'ここでエラー
If uc Is Nothing Then
Set uc = .Range(u)
Else
Set uc = Union(.Range(u), uc)
End If
Next u
uc.EntireColumn.Hidden = True
Set uc = Nothing
End With
End Sub
どこがまずいのでしょうか?
よろしくお願いします。
.
さっそくありがとうございます。
.Range(Join(ArI(), ",")).Select もエラーになります。
それで以下のようにしてみたのですが、
1.行が途中(198行以降)は赤でも非表示になりません。
2.列のところで
For Each u In ArC() が、「実行時エラー92 Forループが初期化されていません」となってしまいました。
ご教示賜われば幸いです。
コードは補足欄に書きます。
No.2
- 回答日時:
こんばんは。
私には良く分からないですが、ひとつだけ、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
この回答への補足
ちなみにエラーになった.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
でした。
多すぎるのでしょうか?
ありがとうございます。
非表示にした行列を表示するのは、
Private Sub 行列表示()
With ActiveSheet
.Cells.EntireRow.Hidden = False
.Cells.EntireColumn.Hidden = False
End With
End Sub
で、瞬時に出来ますのでトグルにする必要はないんでが、そのままやってみたところ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」となってしまいます。
.Range(Join(ArI(), ",")).EntireRow.Hidden = True がひっかかるようです。どこがわるいのでしょうか?
No.1
- 回答日時:
こんにちは。
Sub try()
Dim r As Range
Dim x As Long
Dim y As Long
Dim t As Single '○
t = Timer '○
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With ActiveSheet
.DisplayPageBreaks = False '●
With .Cells(1).SpecialCells(xlLastCell)
x = .Row
y = .Column
End With
For Each r In .Range("A2").Resize(x - 1)
If r.Interior.ColorIndex = 3 Then
r.EntireRow.Hidden = True
End If
'Application.StatusBar = r.Row
Next
For Each r In .Range("A1").Resize(, y)
If r.Interior.ColorIndex = 3 Then
r.EntireColumn.Hidden = True
End If
'Application.StatusBar = r.Column
Next
End With
Application.StatusBar = False '""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print Timer - t '○
End Sub
こんな感じではどうでしょう。
列幅行高を弄くる時には●処理があったほうが良いと思います。
また、改ページプレビューの場合はノーマルにしておいたほうが良いでしょう。
○は時間測定なので必要なくなれば削除してください。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) マクロ実行時、自動で背景色を変えたい。 C列にあるチェックボックスをチェックするとB列に「TRUE」 4 2022/11/08 11:14
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Excel(エクセル) エクセルVBAでオブジェクトが必要です 2 2022/09/10 16:37
- Visual Basic(VBA) ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています 17 2022/12/07 12:03
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Visual Basic(VBA) ExcelVBAで、index、match関数を使用して、指定範囲に出力したい 3 2022/10/18 21:53
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
- Visual Basic(VBA) excel VBA if文について 3 2022/03/27 17:42
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで、絶対値の平均を算...
-
表にフィルターをかけ、絞った...
-
array関数で格納した配列の型を...
-
iniファイルのキーと値を取得す...
-
[エクセル]連続する指定範囲か...
-
[VBA]改行入りのセルの値を配列...
-
読み込みで一行おきに配列に格納
-
Excelのセルの色指定をVBAから...
-
16進数から2進数へ
-
VBA-読み込んだテキストフ...
-
配列がとびとびである場合の書き方
-
Sessionに格納した二次元配列を...
-
スプレットシートのGetTextにつ...
-
仮想リストコントロールの表示
-
ショッピングカートの合計金額...
-
For Nextマクロの高速化につい...
-
ExcelのINDEXとMATCH関数でスピ...
-
VBAでの100万行以上のデータの...
-
エクセルVBA コンボボックスの...
-
Excel VBA 重複値を排除するには?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelのINDEXとMATCH関数でスピ...
-
array関数で格納した配列の型を...
-
Excelのセルの色指定をVBAから...
-
[エクセル]連続する指定範囲か...
-
エクセルで、絶対値の平均を算...
-
VBA listBoxについて
-
表にフィルターをかけ、絞った...
-
VBA 配列に格納した値の平均の...
-
iniファイルのキーと値を取得す...
-
[VBA]改行入りのセルの値を配列...
-
配列がとびとびである場合の書き方
-
エクセルでエラーを無視して一...
-
DataSetから、DataTableを取得...
-
Excel オートフィルタのリスト...
-
Split関数でLong配列に格納する...
-
読み込みで一行おきに配列に格納
-
VB6.0 ファイルの一括読込み
-
SUMPRODUCT関数を用いた最小値
-
INDEX(D:D,L3)の意味は?
-
Dictionaryを使い4つの条件の一...
おすすめ情報