Страницы: 1
RSS
Выделить ячейки начиная с первой до двух подряд пустых в одном столбце, Выделить ячейки начиная с первой до двух подряд пустых в одном столбце
 
Уважаемые форумчане! Нужна помощь. Есть таблица нужно выбрать ячейки в столбце А с первой до двух подряд пустых.

На листе 2 в столбце А необходимо вывести все значения из столбца А на листе 1, не присутствующие в списке "На исключение" на листе 1
 
По первому вопрос вариант:
Код
Sub Macro1()
Dim LastRow As Long, i As Long, RowEnd As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow - 2
        If Cells(i + 1, 1) = "" Then
            If Cells(i + 2, 1) = "" Then
                RowEnd = i + 2
                Exit For
            End If
        End If
    Next
    Range(Cells(1, 1), Cells(RowEnd, 1)).Select
End Sub
Если же пустых захватыват не нужно, то строку 7 измените так: RowEnd = i
А с какой целью выделяете диапазон? Ведь не ради самого факта выделения?
===
Второй вопрос никакого отношения к этой теме не имеет.
 
Большое спасибо. Юрий М,  Но есть небольшая проблема. Если в столбце нет ячеек заполненных после двух пустых вылетает ошибка.
 
Исправил:
Код
Sub Macro1()
Dim LastRow As Long, i As Long, RowEnd As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow '- 2
        If Cells(i + 1, 1) = "" Then
            If Cells(i + 2, 1) = "" Then
                RowEnd = i ' + 2
                Exit For
            End If
        End If
    Next
    Range(Cells(1, 1), Cells(RowEnd, 1)).Select
End Sub
 
Юрий М, Спасибо еще раз. Вы меня очень выручили.
 
Позволю предложить
Код
Sub Macro1()
Dim r As Range
    For Each r In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp).Offset(2)).SpecialCells(xlCellTypeBlanks).Areas
        If r.Count > 1 Then
            Range(Cells(1, 1), r.Cells(1, 1).Offset(-1)).Select
            Exit For
        End If
    Next
End Sub

Если надо выделить включая пустые, то
Код
Sub Macro1()
Dim r As Range
    For Each r In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp).Offset(2)).SpecialCells(xlCellTypeBlanks).Areas
        If r.Count > 1 Then
            Range(Cells(1, 1), r).Select
            Exit For
        End If
    Next
End Sub
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх