Выделение несмежные диапазоны в VBA

Question

Добрый день! Есть таблица нужно Выделить фрукты и получить выделение диапазонов "A1:C4" "A11:C13". И так же аналогично с овощями и ягодами. я написал такое но он выделять только строку.

sSubStr = "Фрукты"
    lCol = 1
    If lCol = 0 Then Exit Sub
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.rows.Count
    arr = Cells(1, lCol).Resize(lLastRow).Value
    Application.ScreenUpdating = 0
    Dim rr As Range
    For li = 1 To lLastRow
        If CStr(arr(li, 1)) = sSubStr Then
            If rr Is Nothing Then
                Set rr = Cells(li, 1)
            Else
                Set rr = Union(rr, Cells(li, 1))
            End If
        End If
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Select
    Application.ScreenUpdating = 1

помогите с решение вопроса

Answer 1

Sub test1()
    sSubStr = "Фрукты"
    With ActiveSheet
        Set Rng = .Cells(1, 1).CurrentRegion 'забираем сразу весь смежный диапазон с данными
        Dim rr As Range, hook As Boolean ' hook - признак режима захвата, изначально False
        For Each cl In Rng.Columns(1).Cells ' итерируем по первому столбцу диапазона
            If cl = sSubStr Then hook = True ' если текст совпал, включаем режим захвата
            If Not IsEmpty(cl) And cl <> sSubStr Then hook = False 'если текст не совпал и не пустая ячейка, отключаем режим захвата
            If hook Then ' если режим захвата, собираем поддиапазоны
                If rr Is Nothing Then
                    Set rr = cl.Resize(, Rng.Columns.Count)
                Else
                    Set rr = Union(rr, cl.Resize(, Rng.Columns.Count))
                End If
            End If
        Next
        If Not rr Is Nothing Then rr.Select
    End With
End Sub

БЛОГ НА HUSL

Выделение несмежные диапазоны в VBA

Ответы (1 шт):