Фильтр строк с закрашенными ячейками и заданному диапазону

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Фильтр строк с закрашенными ячейками и заданному диапазону (Макросы/Sub)

Алина_

Дата: Среда, 04.02.2015, 00:22 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Добрый день всем.

Нужен макрос чтобы отфильтровать исходные данные. Количество строк непредсказуемо - может быть и 10,000.
Некоторые строки имеют закрашенные ячейки. Каждая строка должна сверятся с диапазонами (диапазон задается каждый раз разный)

Цель фильтра
1. Удалить строки, где все ячейки одной строки попадают в указанные диапазоны
2. Удалить строки, где количество закрашенных ячеек 0,1 и 5.

Пример прилагается. В колонке F пояснения к каждой строке, которую надо удалить

Спасибо за помощь.
Алина

К сообщению приложен файл: 0909976.xlsx (12.1 Kb)

Ответить

Karataev

Дата: Среда, 04.02.2015, 14:42 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 1334

Репутация: 533 ±

Замечаний: 0% ±

Excel

[vba]

Код

Sub Macro1()
     Dim arrData(), arrDiaps()
     Dim dic As Object
     Dim lngLastRow As Long
     Dim lngCount As Long
     Dim r As Long, c As Long, i As Long
     Application.ScreenUpdating = False
     lngLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
     arrData = Range("A1:E" & lngLastRow).Value
     arrDiaps = Range("I3:J4").Value
     Set dic = CreateObject("Scripting.Dictionary")
     For r = UBound(arrData) To 1 Step -1
         dic.RemoveAll
         For c = 1 To 5
             For i = 1 To UBound(arrDiaps)
                 If arrData(r, c) >= arrDiaps(i, 1) And arrData(r, c) <= arrDiaps(i, 2) Then
                     If dic.Exists(i) = False Then
                         dic.Add i, ""
                     End If
                     Exit For
                 End If
             Next
         Next
         If dic.Count = 1 Then
             Rows(r).Delete
         Else
             lngCount = 0
             For c = 1 To 5
                 If Cells(r, c).Interior.Color = 255 Then
                     lngCount = lngCount + 1
                 End If
             Next
             Select Case lngCount
                 Case 0, 1, 5
                     Rows(r).Delete
             End Select
         End If
     Next
     Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

Алина_

Дата: Пятница, 06.02.2015, 17:57 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Спасибо, Karataev.

Работает не совсем так. Выходит все в дупликате.
Всего в примере должно было остаться 4 строки, а получилось 8. Пример прилагается.

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

С Благодарностью,
Алина

К сообщению приложен файл: example.xlsm (20.3 Kb)

Сообщение отредактировал Алина_ - Пятница, 06.02.2015, 18:02

Ответить

Karataev

Дата: Пятница, 06.02.2015, 18:20 | Сообщение № 4

Группа: Проверенные

Ранг: Старожил

Сообщений: 1334

Репутация: 533 ±

Замечаний: 0% ±

Excel

изменил макрос,чтобы удалялись строки не целиком
макрос запускается кнопкой,которую вы сделали
я переменные вернул обратно,т.к. я делал макрос под локальные переменные.
у меня работает на этом файле(смотрите прикрепленный файл)

К сообщению приложен файл: Macro_v1.xlsm (19.6 Kb)

Сообщение отредактировал Karataev - Пятница, 06.02.2015, 18:22

Ответить

Алина_

Дата: Пятница, 06.02.2015, 18:33 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Спасибо еще раз, Karataev.
Все работает.

С Уважением,
Алина.

Ответить

Алина_

Дата: Среда, 18.02.2015, 05:58 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Уважаемый Karataev,

попробовали запустить файл на Мас и получили ошибку "Run-time error '429' Active X component can't create object. "
Не подскажете как с этим бороться?

Спасибо,
Алина

Ответить

Pelena

Дата: Среда, 18.02.2015, 08:00 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 19187

Репутация: 4421 ±

Замечаний: ±

Excel 365 & Mac Excel

К сожалению MAC не поддерживает Scripting.Dictionary

Есть замены, но макрос придется переделывать
https://github.com/VBA-tools/VBA-Dictionary
http://www.ozgrid.com/forum/showthread.php?t=159428

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Алина_

Дата: Четверг, 19.02.2015, 02:29 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Спасибо за наводку, Pelena. Попробую.

Ответить

Алина_

Дата: Пятница, 20.02.2015, 21:08 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Уважаемый Karataev,

протестировала набор данных где удаляемых рядов оказалось намного больше чем тех что должны остаться. Результат -пустая таблица.
Пример с датой прилагается. Всего рядов 799, должно остаться 85. Колонка F в фильтре не участвует. Это просто анализ строки (Y/N).

С Уважением,
Алина

К сообщению приложен файл: Macro_v1_data_s.xlsm (38.7 Kb)

Ответить

RAN

Дата: Суббота, 21.02.2015, 12:53 | Сообщение № 10

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Дело не в колмчестве строк.
Ячейка, закрашенная условным форматированием, и закрашенная ячейка, далеко не одно и то же.
Для макроса Karataev в файле нет ни одной закрашенной ячейки.

Поигрался с фильтром. Дабы не усложнять, таблица должна иметь шапку.
[vba]

Код

Sub Мяу()
     Dim arr, j&, i&
     Application.ScreenUpdating = False
     With ActiveSheet
         arr = [i3:j4].Value
         If .AutoFilterMode Then .AutoFilter.Range.AutoFilter
         .Range("A1:E1").AutoFilter

         For j = 1 To UBound(arr)
             For i = 1 To 5
                 .AutoFilter.Range.AutoFilter Field:=i, Criteria1:=">=" & arr(j, 1), _
                    Operator:=xlAnd, Criteria2:="<=" & arr(j, 2)
             Next
             .AutoFilter.Range.Offset(1).Delete Shift:=xlUp
             For i = 1 To 5
                 .AutoFilter.Range.AutoFilter Field:=i
             Next
         Next
         For i = 1 To 5
             .AutoFilter.Range.AutoFilter Field:=i, Operator:=xlFilterNoFill
         Next
         .AutoFilter.Range.Offset(1).Delete Shift:=xlUp
         For i = 1 To 5
             .AutoFilter.Range.AutoFilter Field:=i, Criteria1:=RGB(255, 0 _
                    , 0), Operator:=xlFilterCellColor
         Next
         .AutoFilter.Range.Offset(1).Delete Shift:=xlUp
         For i = 1 To 5
             .AutoFilter.Range.AutoFilter Field:=i
         Next
         For i = 1 To 5
             .AutoFilter.Range.AutoFilter Field:=i, Operator:=xlFilterNoFill
         Next
         For i = 1 To 5
             .AutoFilter.Range.AutoFilter Field:=i, Criteria1:=RGB(255, 0 _
                    , 0), Operator:=xlFilterCellColor
             .AutoFilter.Range.Offset(1).Delete Shift:=xlUp
             .AutoFilter.Range.AutoFilter Field:=i, Operator:=xlFilterNoFill
         Next
         .AutoFilter.Range.AutoFilter
     End With
End Sub

[/vba]

Код

[/vba]RAN

К сообщению приложен файл: 6682615.xlsm (48.8 Kb)

Быть или не быть, вот в чем загвоздка!

Ответить

СообщениеДело не в колмчестве строк.
Ячейка, закрашенная условным форматированием, и закрашенная ячейка, далеко не одно и то же.
Для макроса Karataev в файле нет ни одной закрашенной ячейки.

Поигрался с фильтром. Дабы не усложнять, таблица должна иметь шапку.
[vba]

Код

[/vba]

Автор - RAN
Дата добавления - 21.02.2015 в 12:53

Алина_

Дата: Вторник, 24.02.2015, 07:58 | Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Спасибо, RAN, я не знала о разнице между закрашенными и условно форматированными ячейками.

Как добавить в Ваш код дополнительный шаг чтобы после фильтрации значения диапазона и кнопка не исчезали?

С Уважением,
Алина