Excel VBA:清理代码

时间:2018-06-25 17:21:45

标签: excel-vba vba excel

我是VBA的新手,并且编写了基本的excel代码,该代码在一系列单元格中循环并隐藏单元格值为零的行。代码工作正常,我没有任何问题;但是,代码感觉很冗长,我想知道是否有一种方法可以缩短它或清理它,以便将来对于新用户来说更容易编辑/关注。

我在下面发布了代码:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False


If Not Intersect(Target, Me.Range("J7")) Is Nothing Then


    Select Case Target.Value
        Case "Filter"
            Worksheets("Filtered Data").Rows("7:1000").EntireRow.Hidden = False

            Dim X As Range

            With Worksheets("Filtered Data")
                .Rows("7:1000").EntireRow.Hidden = False
                If .Range("J7") = "Filter" Then
                    For Each X In .Range("J10:J503")
                        If X.Value = 0 Then
                            X.EntireRow.Hidden = True
                        End If
                    Next X
                End If
            End With
        Case "Unfilter"
            Worksheets("Filtered Data").Rows("7:1000").EntireRow.Hidden = False
        Case "-- Select --"
            Worksheets("Filtered Data").Rows("7:1000").EntireRow.Hidden = False
    End Select

Else

    If Not Intersect(Target, Me.Range("I7")) Is Nothing Then

        Select Case Target.Value
            Case "Filter"
                Worksheets("Filtered Data").Rows("7:1000").EntireRow.Hidden = False

                Dim Y As Range

                With Worksheets("Filtered Data")
                    .Rows("7:600").EntireRow.Hidden = False
                    If .Range("I7") = "Filter" Then
                        For Each Y In .Range("I10:I503")
                            If Y.Value = 0 Then
                                Y.EntireRow.Hidden = True
                            End If
                        Next Y
                    End If
                End With
            Case "Unfilter"
                Worksheets("Filtered Data").Rows("7:1000").EntireRow.Hidden = False
            Case "-- Select --"
                Worksheets("Filtered Data").Rows("7:1000").EntireRow.Hidden = False
        End Select
    End If
End If

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:0)

似乎用户可以在I7或J7中选择三个文本值。这两个单元格可能包含数据验证列表或类似的内容,因为在每次打开或关闭过滤操作时手动键入值似乎不太实际。

我受到您选择工作表名称的启发,并使用了.AutoFilter方法。我假设这一切都在Worksheets(“ Filtered Data”)的私有代码表中,并且您的I7:J7选项不在另一个工作表中。

虽然可以像粘贴一样在单个操作中同时更改I7和J7,但我已将操作一次缩减为仅一次列过滤。这似乎反映出我从原始代码中收集的信息。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'Exit Sub
    If Not Intersect(Target, Range("I7:J7")) Is Nothing Then
        On Error GoTo meh
        Application.EnableEvents = False
        Dim t As Range
        Set t = Intersect(Target, Range("I7:J7")).Cells(1)
        With Intersect(Columns(t.Column), Cells(7, t.Column).Resize(99999, 1), Me.UsedRange)
            If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False

            If LCase(t.Value2) = "filter" Then
                .AutoFilter Field:=1, Criteria1:="<>0", Criteria2:="<>", _
                            Operator:=xlAnd, VisibleDropDown:=False
            End If
        End With
        Range("J7").Offset(0, Int(t.Column = Range("J7").Column)) = "'-- Select --"
    End If

meh:
    Application.EnableEvents = True

End Sub