Отображение строк, где есть хотя бы один пробел

[willy]

Есть таблица 40000-50000 строк и 10 столбцов.
В ней могут пустые ячейки. Задача в том, чтобы их обнаружить. До этого делали автофильтром по каждому столбцу. Долго и не удобно. Я изучаю VBA всего 4 дня, но нашел способ, что-то типа:

Sub EmptyRows()
Dim oEnd As Integer

Range("A1").Select
oEnd = Selection.End(xlDown).Row

For colIndex = 6 To 6
For rwIndex = 1 To oEnd

With ActiveSheet.Cells(rwIndex, colIndex)
If .Value <> 0 Then
Rows(rwIndex).Hidden = True
End If
End With
Next rwIndex
Next colIndex

End Sub

Но с такой большой таблицей - этот метод работает еще дольше чем автофильтр.

Я знаю есть более быстрые варианты типа ActiveSheet.UsedRange.SpecialCells( xlCellTypeBlanks).Select

но не знаю как показать только те строки, где есть хотя бы одна пустая ячейка

[nilem]

Например, так:

Dim rng As Range
Application.ScreenUpdating = False
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 10)
With rng
    .EntireRow.Hidden = True
    .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
End With
Application.ScreenUpdating = True

[willy]

Спасибо огромное, добрый человек. Пошел учить матчасть :-)

[SAS888]

С позволения nilem, отмечу, что строка кода, определяющая диапазон

Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 10)

будет некорректна, в случае, если в каком-либо столбце строк больше, чем в столбце "A". Предлагаю в качестве диапазона rng использовать ActiveSheet.UsedRange. Если же таблицу требуется ограничить 10-ю столбцами, то можно использовать

Set rng = Intersect(ActiveSheet.UsedRange, [A:J])

[nilem]

Set rng = Intersect(ActiveSheet.UsedRange, [A:J])

Согласен, так более универсально.
...хотя вчера ведь думал об этом. "Если в каком-либо столбце строк больше, чем в столбце "A"", то, значит, соответствующие ячейки в ст. А пустые, а их нужно оставить открытыми. И тогда
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 10)
будет даже эффективнее.

[SAS888]

Согласен. Для решения данной задачи это вполне устраивает.
Но есть еще один вопрос:
Автор говорит, что

Есть таблица 40000-50000 строк...

и никак не оговаривает, каким образом она может быть заполнена.
Однако, пусть, например, столбец "A" заполнен, начиная с 1-й строки и пусть через каждую строку встречается пустое значение. В этом случае, применение метода SpecialCells даст ошибочный результат. Для SpecialCells количество несвязанных диапазонов ограничено (8192). Для примера, попробуйте на пустом листе выполнить макрос:

Sub Test()
    Dim i As Long, m As Long, a(): Application.ScreenUpdating = False
    m = InputBox("Количество строк"): [A:A].Delete: ReDim a(1 To m, 1 To 1)
    For i = 1 To UBound(a, 1) Step 2: a(i, 1) = i: Next
    Range("A1:A" & m).Value = a
    [A:A].SpecialCells(xlCellTypeBlanks).Select
End Sub

где m - это количество заполняемых строк в столбце "A" (массив примененяется только из-за экономии времени и проверка введенного значения переменной m отсутствует). Попробуйте запустить макрос и задать m = 16380. А затем, например, m = 16390. Результат очевиден.

P.S. Для 10-и столбцов такая ситуация еще более возможна.

[nilem]

Не знал о таком ограничении, спасибо. Для интереса попробовал в 2010 - выделяет до 50000 несвязанных ячеек (дальше не стал экспериментировать).
И что же теперь делать нашему ТС? Вот что пришло в голову (как-то сразу пришло и прочно засело)

Sub ToHideEmptyCells()
Dim x, i As Long, j As Long, y()
Application.ScreenUpdating = False
x = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 10).Value

With CreateObject("Scripting.Dictionary")
'With New Dictionary     ' здесь нужен Reference на MS Scripting Runtime
    For i = 1 To UBound(x, 1)
        For j = 1 To 10
            If IsEmpty(x(i, j)) Then
            If Not .Exists(i) Then .Add Key:=i, Item:=0
            End If
        Next j, i: y = .Keys
End With
For i = 0 To UBound(y)
    Cells(y(i), 1).EntireRow.Hidden = True
Next i
Application.ScreenUpdating = True
End Sub

Не слишком ли?

[EugeneS]

вариант с использованием библиотеки ADO:

Предварительная настройка: Excel - Ctrl+F11 - VB redaktor: Tools – References: подключите библиотеку Microsoft ActiveX Data Objects 2.8 Library

см. вложение

[nilem]

Сообщение от nilem

...Не слишком ли?

Конечно, слишком. Вот:

Sub ToHideEmptyCells2()
Dim x, i As Long, j As Long
Application.ScreenUpdating = False
x = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 10).Value
For i = 1 To UBound(x, 1)
    For j = 1 To 10
        If IsEmpty(x(i, j)) Then
            Cells(i, 1).EntireRow.Hidden = True
            Exit For
        End If
Next j, i
Application.ScreenUpdating = True
End Sub