Добрый день. Прошу помочь. Есть файл со множество строк, макрос должен применить фильтр к колонке D. Фильтр "содержит ad_id". После применения фильтра остается какое-то количество строк. В колонке E необходимо прописать "выборка1". Далее отменить фильтр и сделать то же самое со столбцом C. Пример прилагаю.
Добрый день. Прошу помочь. Есть файл со множество строк, макрос должен применить фильтр к колонке D. Фильтр "содержит ad_id". После применения фильтра остается какое-то количество строк. В колонке E необходимо прописать "выборка1". Далее отменить фильтр и сделать то же самое со столбцом C. Пример прилагаю.chebykina_n_88
Sub chebykina_n_88() Dim aR As Long, c_id As String aR = ThisWorkbook.Worksheets("Лист1").Cells(1000, 1).End(xlUp).Row + 1 c_id = "*ad_id*" Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Лист1").Range("A2:D" & aR).CurrentRegion .AutoFilter 4, "=" & c_id .AutoFilter 3, "=" & c_id End With
With ThisWorkbook.Worksheets("Лист1")
With .AutoFilter.Range
If .Columns(3).SpecialCells(xlCellTypeVisible).Count > 1 _ And .Columns(4).SpecialCells(xlCellTypeVisible).Count > 1 Then .Columns(5).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Value = "выборка1" End If
End With
If .AutoFilterMode = True Then .AutoFilterMode = False End With
Application.ScreenUpdating = True End Sub
[/vba] Всё отлично отрабатывает. Удачи.
chebykina_n_88, Здравствуйте. [vba]
Код
Option Explicit
Sub chebykina_n_88() Dim aR As Long, c_id As String aR = ThisWorkbook.Worksheets("Лист1").Cells(1000, 1).End(xlUp).Row + 1 c_id = "*ad_id*" Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Лист1").Range("A2:D" & aR).CurrentRegion .AutoFilter 4, "=" & c_id .AutoFilter 3, "=" & c_id End With
With ThisWorkbook.Worksheets("Лист1")
With .AutoFilter.Range
If .Columns(3).SpecialCells(xlCellTypeVisible).Count > 1 _ And .Columns(4).SpecialCells(xlCellTypeVisible).Count > 1 Then .Columns(5).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Value = "выборка1" End If
End With
If .AutoFilterMode = True Then .AutoFilterMode = False End With
Sub Макрос1() Dim arr, arr_1, n As Long arr = Range("C2:D" & Cells(Rows.Count, 3).End(xlUp).Row) ReDim arr_1(1 To UBound(arr), 1 To 1) For n = 1 To UBound(arr) If arr(n, 1) Like "*ad_id*" Or arr(n, 2) Like "*ad_id*" Then arr_1(n, 1) = "выборка1" Next [e2].Resize(UBound(arr_1)).ClearContents [e2].Resize(UBound(arr_1)) = arr_1 End Sub
[/vba]
Можно это сделать без использования фильтра [vba]
Код
Sub Макрос1() Dim arr, arr_1, n As Long arr = Range("C2:D" & Cells(Rows.Count, 3).End(xlUp).Row) ReDim arr_1(1 To UBound(arr), 1 To 1) For n = 1 To UBound(arr) If arr(n, 1) Like "*ad_id*" Or arr(n, 2) Like "*ad_id*" Then arr_1(n, 1) = "выборка1" Next [e2].Resize(UBound(arr_1)).ClearContents [e2].Resize(UBound(arr_1)) = arr_1 End Sub