Excel VBA: очистка кода - PullRequest
0 голосов
/ 25 июня 2018

Я новичок в 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 голосов
/ 25 июня 2018

Кажется, что у пользователя есть выбор из трех текстовых значений в I7 или J7.Вполне вероятно, что эти две ячейки содержат списки проверки данных или что-то подобное, так как не очень удобно, чтобы они вводили значения вручную каждый раз, когда включается или выключается операция фильтрации.

Я был вдохновленпо вашему выбору имен листа и пошел с методом .AutoFilter.Я предположил, что это все в личном кодовом листе рабочих таблиц («Отфильтрованные данные») и что ваши параметры 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...