Sub УдалениеСтрокПоУсловию2()
    Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана
 
    ТекстДляПоиска = "шт"    ' удаляем строки с таким текстом
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
    
End Sub

Sub УдалениеСтрокПоУсловию2()
    Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана
 
    ТекстДляПоиска = "шт"    ' удаляем строки с таким текстом
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
    
End Sub

Sub Ze()

LR = Cells(Rows.Count, 1).End(xlUp).Row
 
    For i = LR To 2 Step -1
            
       str_test = Cells(i, 1).Value = Right(String(7, "0") & str_test, 7)
          
        Next
    
End Sub

Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
 
For i = LR To 3 Step -1
    For j = i - 1 To 3 Step -1
     If Cells(i, 3).Value = Cells(j, 3).Value _
        And Cells(i, 6).Value = Cells(j, 6).Value _
                Then
        Cells(i, 5).Value = Cells(i, 5).Value + Cells(j, 5).Value
        Cells(i, 1).Value = Cells(i, 1).Value & "," & Cells(j, 1).Value
        Rows(j).Delete
     End If
    Next
Next
Application.ScreenUpdating = True

Sub УдалитьСтроки()
    Dim r As Range
    Set r = Selection
    Dim y As Long
    For y = r.Row + r.Rows.Count - 1 To r.Row Step -1
        If Cells(y, 8).Value = "" Then
            Rows(y).Delete
        End If
    Next
End Sub