Подскажите - как отфильтровать и скопировать регион?

[Andrey Fedorov]

Нужно - определенный регион на листе отфильтровать по колонке (пустое поле или значение не дата) и результат скопировать на другой лист. Подскажите, как это лучше сделать кодом на VBA...

Попытки разобраться к ничему такому что самому понравится пока не привели...

[uhm]

Речь про Эксель, правильно?

У меня код, полученный по записи макроса, сработал после минимальной доработки напильником. Т. е. если копировать все строки области, на которую наложен фильтр, а потом их вставлять, то вставятся только те, которые удовлетворяли условию фильтра - хоть ручками делай, хоть макросом.

Т. е. код буквально вот такой:

Код: Выделить всё

    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$B$18").AutoFilter Field:=1, Criteria1:="1"
    Rows("2:18").Copy
    Sheets("zzz").Cells(1, 1).PasteSpecial


[Andrey Fedorov]

У меня код, полученный по записи макроса, сработал после минимальной доработки напильником.

Мне нужно чтобы соблюдались одновременно два условия:

1. Не пустая ячейка колонки A
2. Ячейка колонки B пустая или содержит значение не даты.

Как это прописать в автофильтр???

[uhm]

Ясно, я по формулировке вопроса подумал, что проблемы вызывает именно копирование

Кроме дат что-то еще в числовом формате в колонке В может быть? Если да, то я не уверен, что это вообще возможно - загнать в автофильтр проверку того, что что-то является датой.

[Andrey Fedorov]

Кроме дат что-то еще в числовом формате в колонке В может быть? Если да, то я не уверен, что это вообще возможно - загнать в автофильтр проверку того, что что-то является датой.

Обычно есть текст. Не числа.

[uhm]

Мдя... отобрать даты, оказывается, куда проще, чем не даты

Я уже готов, если Excel 2007, предложить выделить даты другим цветом и сделать фильтр по цвету шрифта... Хотя решение зверски некрасивое, да и Эксель наверняка окажется 2003 и ранее

Пошел думать дальше...

[uhm]

А, ну и еще стандартно - если нет запрета на использование дополнительных колонок, то проще добавить колонку, в которой формулами вычислить, то ли, что нужно, стоит в колонке B, и дальше фильтровать по новой колонке.

[Andrey Fedorov]

Мдя... отобрать даты, оказывается, куда проще, чем не даты

Дык в том то и сложность... Да еще дополнительный фильтр по другой колонке...

Пошел думать дальше...

Сие есть гуд! А то с Excel-ем работаю дюже периодически...

[uhm]

А использование автофильтра принципиально? Потому что все проблемы именно в его ограниченности, я все сильнее подозреваю, что без дополнительной колонки или манипуляций с цветами задача не решается. Может быть, проще пройтись циклом по всем строкам области и просто формулами VBA проверить условия и скопировать нужные строки?

[Andrey Fedorov]

А использование автофильтра принципиально? Потому что все проблемы именно в его ограниченности, я все сильнее подозреваю, что без дополнительной колонки или манипуляций с цветами задача не решается. Может быть, проще пройтись циклом по всем строкам области и просто формулами VBA проверить условия и скопировать нужные строки?

Там штук 20 закладок и в каждой может быть тысячи записей. Так что работать будет дюже долго...

Сейчас у меня работает копирование через Recordset, но там свои прелести - в колонках юзер может ввести данные разного типа...

[Gloom]

Примерчик:

Код: Выделить всё

Dim firstSheet As Worksheet
Dim dataRange1 As Range, dataRange2 As Range, criteriaRange As Range, targetRange As Range
   
Set firstSheet = Worksheets(1)
   
Set dataRange1 = firstSheet.Range("A1:A7")
Set dataRange2 = dataRange1.Offset(ColumnOffset:=1)
Set criteriaRange = firstSheet.Range("C1:C2")
Set targetRange = Worksheets(2).Range("A1")
   
' создаём исходный диапазон
dataRange1.Value = WorksheetFunction.Transpose(Array("Date", "1/1/08", "1/2/08", Empty, "1/3/08", "test", "1/4/08"))
dataRange2.Value = WorksheetFunction.Transpose(Array("Text", "Row_1", "Row_2", "Row_3", "Row_4", "Row_5", "Row_6"))
   
' фильтруем диапазон и помещаем результат на второй лист
criteriaRange.Cells(2).Formula = "=IF(N(A2)>0,0,1)"
Application.Union(dataRange1, dataRange2).AdvancedFilter xlFilterCopy, criteriaRange, targetRange

[uhm]

Не совсем честно, поскольку все равно используются дополнительные ячейки

[KL]

Код: Выделить всё

Sub Test()
    Sheets(1).Range("B:B").SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Copy Sheets(2).Range("A2")
End Sub

[Andrey Fedorov]

Примерчик:

Интересно... Попробую...

[Andrey Fedorov]

Если вместо:

Примерчик:

Код: Выделить всё

...
Application.Union(dataRange1, dataRange2).AdvancedFilter xlFilterCopy, criteriaRange, targetRange

поставить

Код: Выделить всё

firstSheet.Range("A1:B7").AdvancedFilter xlFilterCopy, criteriaRange, targetRange

все работает, но мне не нужно чтобы копировался заголовок таблицы, пытаюсь выполнить

Код: Выделить всё

firstSheet.Range("A2:B7").AdvancedFilter xlFilterCopy, criteriaRange, targetRange

И нарываюсь на ошибку. Как быть?

[KL]

Код: Выделить всё

firstSheet.Range("A1:B7").AdvancedFilter xlFilterCopy, criteriaRange, targetRange

все работает, но мне не нужно чтобы копировался заголовок таблицы, пытаюсь выполнить

Ну во-первых, самое простое это цинично удалить заголовок после копирования.

Но если очень надо, то можно и так:

Код: Выделить всё

Sub test()
    Dim targetRange As Range
    Dim criteriaRange As Range
   
    Set targetRange = SecondSheet.Range("A3")
    Set criteriaRange = SecondSheet.Range("A1:B2")
   
    Application.ScreenUpdating = False
    With firstSheet.Range("A1:B7")
        .AdvancedFilter xlFilterInPlace, criteriaRange
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy targetRange
        .Parent.ShowAllData
    End With
    Application.ScreenUpdating = True
End Sub