Как скрыть следующие 30 строк ниже «второго» дублирующего значения в Excel VBA - PullRequest
0 голосов
/ 30 августа 2018

Я много искал по этому вопросу и не мог сделать это сам, поэтому попытался получить мнение эксперта

Я хотел бы скрыть блок строк на основе повторяющихся значений, но оставив первое повторяющееся значение и строки видимыми, что означает:

У меня есть ячейки B20, B50,B80,B110,B140 и т. Д., Которые заполняются автоматически на основе записей на других листах «нет проблем», поэтому данные не являются уникальными «каждый раз одинаково» и могут часто иметь дублирующееся значение. Я хочу скрыть следующее ниже 30 строк для второго дубликата, оставляя первый блок как есть. Пример: в приведенном ниже примере для значения ячейки 1111 я бы хотел, чтобы строки 20–49 были видны «потому что это первый дубликат», но скрыть строки 80–109 и скрыть также строки 140–169, поскольку они являются вторыми и третьими дубликаты и т. д.

B20 1111
B21 something
B22 something
.
.
.
B50 2222
B51 something
B52 something
.
.
.
B80 1111
B81 something
B82 something
.
.
.
B110 2222
B111 something
B112 something
.
.
.
B140 1111
B141 something
B142 something
.
.
.
Etc…

До сих пор я пробовал много вещей, но не смог сделать выборочное скрытие строки блока на основе дубликатов, как в примере выше. Поэтому, если у вас есть время, поделитесь своей магией.

1 Ответ

0 голосов
/ 30 августа 2018

Поместите этот код в личный кодовый лист рабочего листа (щелкните правой кнопкой мыши на вкладке имени рабочего листа, Просмотреть код)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B20,B50,B80,B110,B140")) Is Nothing Then
        On Error GoTo safe_exit
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Dim t As Range, r As Range, b As Boolean
        Range("B20").Resize(150, 1).EntireRow.Hidden = False
        For Each t In Range("B20,B50,B80,B110,B140")
            b = False
            For Each r In Range("B20,B50,B80,B110,B140")
                If r.Value = t.Value And b Then
                    r.Resize(30, 1).EntireRow.Hidden = b
                ElseIf r.Value = t.Value Then
                    r.Resize(30, 1).EntireRow.Hidden = b
                    b = True
                End If
            Next r
        Next t
    End If

safe_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub
...