Доброго дня. Столкнулся с проблеммкой, может кто-нибудь сможет помочь: нужно написать макрос, который будет пробегаться по столбцу все таблицы( длинна таблицы не ограниченна). находить в первом столбце слово "Пусто" и удалять эту строку и ещё две строки над ней... написал формулу которая проставляет это значение "Пусто" ,а вот с макросом беда...
Доброго дня. Столкнулся с проблеммкой, может кто-нибудь сможет помочь: нужно написать макрос, который будет пробегаться по столбцу все таблицы( длинна таблицы не ограниченна). находить в первом столбце слово "Пусто" и удалять эту строку и ещё две строки над ней... написал формулу которая проставляет это значение "Пусто" ,а вот с макросом беда...Tigron
Sub FindAndDelete() Dim i As Long, sRow As Long, k
With ActiveSheet sRow = .Cells(Rows.Count, 1).End(xlUp).Row For i = sRow To 1 Step -1 If LCase(Cells(i, 1)) = "ïóñòî" Then For k = i To i - 2 Step -1 .Rows(k).EntireRow.Delete Next k End If Next i End With
End Sub
[/vba]
Посмотрите код (работает на активном листе) [vba]
Код
Sub FindAndDelete() Dim i As Long, sRow As Long, k
With ActiveSheet sRow = .Cells(Rows.Count, 1).End(xlUp).Row For i = sRow To 1 Step -1 If LCase(Cells(i, 1)) = "ïóñòî" Then For k = i To i - 2 Step -1 .Rows(k).EntireRow.Delete Next k End If Next i End With
Sub Del_Rows() Dim r As Long, rng As Range For r = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row If Cells(r, 1) = "Пусто" Then If r <= 3 Then MsgBox "Первое ПУСТО слишком близко к краю": Exit Sub If rng Is Nothing Then Set rng = Union(Rows(r), Rows(r - 1), Rows(r - 2)) Else Set rng = Union(rng, Rows(r), Rows(r - 1), Rows(r - 2)) End If Next r If Not rng Is Nothing Then rng.Delete End Sub
[/vba]
Можно ещё так [vba]
Код
Sub Del_Rows() Dim r As Long, rng As Range For r = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row If Cells(r, 1) = "Пусто" Then If r <= 3 Then MsgBox "Первое ПУСТО слишком близко к краю": Exit Sub If rng Is Nothing Then Set rng = Union(Rows(r), Rows(r - 1), Rows(r - 2)) Else Set rng = Union(rng, Rows(r), Rows(r - 1), Rows(r - 2)) End If Next r If Not rng Is Nothing Then rng.Delete End Sub