Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Работа макроса с вводом данных и выполнением на двух рабочих листах
 
Всем привет.

Решил зарегистрироваться так как только начинаю выяснять азы работы макросов VBA.
Вопрос такой. Есть два макроса, которые я запускаю по очереди на двух разных рабочих листах в одном Excel файле. Оба макроса идентичные, отличается только строка с которой начинается цикл проверки. На первом листе работа макроса подразумевает "поиск Х в колонке 2 и удаление всех Y Z H (и т.д)". На втором листе работа такая же, но идёт "поиск Х в колонке 3 и удаление всех Y Z H (и т.д.)".

Я нашёл простую формулу объединения двух макросов через макрос Call. Но в этом случае оба макроса по очереди просят "вводить значение Х и колонку".
Есть ли способ это нивелировать? Указать "один раз Х и колонку" и заставить макрос отработать оба листа? Условно как то сделать работу на Sheets 1 затем переключиться на Sheets 2 и повторить

Макрос 1 будет ниже:
Код
Sub Для_удаления_строчек_на_листе_Привет()
    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 = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 5))
    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 = 4 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
   
Макрос 2 выглядит похожим образом, только цикл начинается с другой строки
Код
Sub Для_удаления_на_листе_SKU()
    Worksheets("SKU").Activate
    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 = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 5))
    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 = 3 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
Страницы: 1
Наверх