Форум по VBA, Excel и Word

VBA, Excel => VBA, макросы в Excel => Тема начата: Maximus80 от 14 Июль 2019, 16:16

Название: Excel VBA Макросы: Макрос для выделения диапазона с учётом цветовой заливки.
Отправлено: Maximus80 от 14 Июль 2019, 16:16
Необходим макрос для выделения диапазона в столбце А по условию: от первой ячейки после последней выделенной желтым цветом до последней заполненной ячейки в столбце.
Название: Re: Excel VBA Макросы: Макрос для выделения диапазона с учётом цветовой заливки.
Отправлено: Администратор от 14 Июль 2019, 16:37
Макрос
Sub Макрос()

    Dim fr As Long, lr As Long, i As Long
   
   
    ' Поиск последней строки в столбце A.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
    ' Поиск жёлтой ячейки снизу вверх.
    For i = lr To 1 Step -1
        If Cells(i, "A").Interior.Color = 65535 Then
            fr = i + 1
            Exit For
        End If
    Next i
   
    ' Если нет жёлтых ячеек.
    If fr = 0 Then
        MsgBox "Жёлтых ячеек нет.", vbExclamation
        Exit Sub
    End If
   
    ' Выделение фрагмента.
    Columns("A").Rows(fr & ":" & lr).Select

End Sub


Примечание

Вообще, выделять не всегда надо, чтобы что-то сделать. Достаточно просто обратиться к нужному фрагменту. То есть вместо Select подставьте нужную команду.
Название: Re: Excel VBA Макросы: Макрос для выделения диапазона с учётом цветовой заливки.
Отправлено: Maximus80 от 14 Июль 2019, 16:44
Большое спасибо.
Название: Re: Excel VBA Макросы: Макрос для выделения диапазона с учётом цветовой заливки.
Отправлено: Администратор от 14 Июль 2019, 16:59
Ещё вариант. Если первый способ будет работать долго, то можете попробовать этот способ.

Макрос
Sub Макрос()

    Dim fr As Long, lr As Long
   
   
    '1. Поиск жёлтой ячейки снизу вверх.
    '1) Сброс настроек оформления у поиска, которые может сделать юзер или другой макрос.
    Application.FindFormat.Clear
    '2) Настройка поиска. Поиск жёлтой заливки.
    Application.FindFormat.Interior.Color = 65535
    '3) Поиск. Окружаем поиск перехватчиком ошибок, чтобы макрос не остановился, если нет жёлтых ячеек.
    On Error Resume Next
    fr = Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=True).Row + 1
    On Error GoTo 0
    '4) Убираем настройки поиска, чтобы они не мешали юзеру.
        ' Настройки поиска видны в диалоге "Найти и заменить".
    Application.FindFormat.Clear
   
    '2. Если нет жёлтых ячеек.
    If fr = 0 Then
        MsgBox "Жёлтых ячеек нет.", vbExclamation
        Exit Sub
    End If
   
    '3. Поиск последней строки в столбце A.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
    '4. Выделение фрагмента.
    Columns("A").Rows(fr & ":" & lr).Select

End Sub
Название: Re: Excel VBA Макросы: Макрос для выделения диапазона с учётом цветовой заливки.
Отправлено: Maximus80 от 14 Июль 2019, 17:06
Спасибо.