[[20220819143301]] 『行の非表示の高速化について』(初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『行の非表示の高速化について』(初心者)

下記コードにより、D列に作業列を設け、値が0の時、その行を非表示にしていますが、対象範囲が広いためか、処理が完了するのに12秒ほどかかります。
高速化する方法がありますか?

Private Sub ToggleButton1_Click()

   ActiveSheet.Unprotect
  Dim LastRow As Long
    Dim i As Long

  Application.ScreenUpdating = False
 With ToggleButton1
        If .Value Then
        .Caption = "空白行表示"                                        'トグルボタンONの処理

   For Each v In Range("D16:D382")
                If v.Value = 0 Then
                    Rows(v.Row).Hidden = True
                Else
                End If
            Next

   Application.ScreenUpdating = True
            MsgBox "空白行を非表示にしました。", vbInformation
        Else
                                                                    'トグルボタンOFFの処理
            .Caption = "空白行非表示"

         For Each v In Range("D16:D382")
                If v.Value = 0 Then
                    Rows(v.Row).Hidden = False
                Else
                End If
            Next
       Application.ScreenUpdating = True
        If silentFlag = False Then
        MsgBox "空白行も表示しました。", vbInformation
        End If
        End If
    End With
 ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFiltering:=True

End Sub

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 オートフィルタをつかってはダメなんですか?
(´・ω・`) 2022/08/19(金) 15:54

 一応...
 新規ブックに10000行の定数値を書き、[D16:D382]に揮発性SUMIF式を置いて実験しました
 提示コードそのままだと大体8秒くらいかかるシートですが、↓こうするだけでもだいぶ速くなったですよ。

    Private Sub ToggleButton1_Click()
        ActiveSheet.Unprotect
        Dim LastRow As Long
        Dim i As Long
        Dim r As Range, v, silentFlag '追記
        Application.ScreenUpdating = False
        With ToggleButton1
            If .Value Then
                .Caption = "空白行表示" 'トグルボタンONの処理
                For Each v In Range("D16:D382")
                    If v.Value = 0 Then
    '                    Rows(v.Row).Hidden = True
                        If r Is Nothing Then Set r = v Else Set r = Union(r, v) '追記
                    Else
                    End If
                Next
                If Not r Is Nothing Then r.EntireRow.Hidden = True '追記
                Application.ScreenUpdating = True
                MsgBox "空白行を非表示にしました。", vbInformation
            Else
                .Caption = "空白行非表示" 'トグルボタンOFFの処理
                For Each v In Range("D16:D382")
                    If v.Value = 0 Then
    '                    Rows(v.Row).Hidden = False
                        If r Is Nothing Then Set r = v Else Set r = Union(r, v) '追記
                    Else
                    End If
                Next
                If Not r Is Nothing Then r.EntireRow.Hidden = False '追記
                Application.ScreenUpdating = True
                If silentFlag = False Then
                    MsgBox "空白行も表示しました。", vbInformation
                End If
            End If
        End With
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, _
            AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFiltering:=True
    End Sub

(白茶) 2022/08/19(金) 16:00


ジャンプ機能を利用してはどうでしょうか。

    Private Sub ToggleButton1_Click()
        ActiveSheet.Unprotect
        Dim LastRow As Long
        Dim r As Range

        Set r = Range("D16:D382")
        r.EntireRow.Hidden = False

        With ToggleButton1
            If .Value Then
                .Caption = "空白行表示" 'トグルボタンONの処理
                On Error Resume Next
                r.SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow.Hidden = True
                On Error GoTo 0
                MsgBox "空白行を非表示にしました。", vbInformation
            Else
                .Caption = "空白行非表示" 'トグルボタンOFFの処理
                MsgBox "空白行も表示しました。", vbInformation
            End If
        End With

        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, _
            AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFiltering:=True

    End Sub

(マナ) 2022/08/19(金) 18:31


みなさま、色々な知恵をお貸しいただきありがとうございます
大変勉強になります
オートフィルターでかなり早くなりました!
(初心者) 2022/08/19(金) 22:27

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.