Страницы: 1
RSS
Цикл макроса на все листы: удалять строки по содержимому значению
 
Добрый день, подскажите пожалуйста, как правильно преобразовать данный макрос (задача которого удалять строки, по содержимому значению) таким образом, чтобы при вызове его он сработал на всех листах книги.

Во вложении файл для тестирования макроса с названиями овощей/фруктов
 
Код
Sub Del_SubStr()

    Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
    Dim lCol As Long      'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim lMet As Long
    Dim arr

    sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "Запрос параметра", "")
    If sSubStr = "" Then lMet = 0 Else lMet = 1
    lCol = 1
    If lCol = 0 Then Exit Sub
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

    arr = Cells(1, lCol).Resize(lLastRow).Value
    Application.ScreenUpdating = 0
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки до конца
        If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then
           If rr Is Nothing Then
              Set rr = Cells(li, 1)
           Else
                Set rr = Union(rr, Cells(li, 1))
            End If
        End If
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub
Изменено: holodushka - 22.11.2019 19:33:05
 
Цитата
как правильно
Для начала прочитать правила
 
Благодарю, учла ваше замечание. Корректно отформатировала код и добавила файл пример. Так же ознакомилась с уже поднятыми вопросами на форуме, однако не удалось внедрить в данный макрос предложенные решения. Буду благодарна за помощь :)
 
А где же макрос в вашем примере?
 
спрятался за буквой S  :D
По вопросам из тем форума, личку не читаю.
 
Цикл по всем листам книги, макрос в стандартный модуль
Код
Sub Del_SubStr()
    Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
    Dim lCol As Long      'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim lMet As Long
    Dim arr
    Dim rr As Range
Dim Sht As Worksheet
    sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "Запрос параметра", "")
    If sSubStr = "" Then lMet = 0 Else lMet = 1
    lCol = 1
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
For Each Sht In Worksheets
  With Sht
    lLastRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
    arr = .Cells(1, lCol).Resize(lLastRow).Value
    For li = 1 To lLastRow 'цикл с первой строки до конца
        If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then
           If rr Is Nothing Then
              Set rr = .Cells(li, 1)
           Else
                Set rr = Union(rr, .Cells(li, 1))
            End If
        End If
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Set rr = Nothing
  End With
Next
    Application.ScreenUpdating = 1
End Sub
 
Kuzmich, большое Вам спасибо за уделённое время, решение отличное и очень пригодилось! Прошу прощение за предоставленные неудобства с оформлением!  
Страницы: 1
Наверх