[a_axe]

например, от слов "ООО ЗСТ" до "Всего по: ООО ЗСТ" выделить строки »

Попробуйте код ниже - он найдет две указанные ячейки и выделит все строчки между ними, после этого вы можете убедиться, что диапазон действительно можно удалять и легко можете удалить строки вручную, нажав сочетание контрол со знаком минус на доп клавиатуре (соответственно - нижняя левая и дальняя правая клавиши).

Скрытый текст

Код:

Public Sub selection_for_deleting()
    Dim rngStart As Range, rngEnd As Range
    Dim strStart As String, strEnd As String
    strStart = InputBox("Введите верхнюю строчку", "Поиск", "ООО ЗСТ")
    strEnd = InputBox("Введите нижнюю строчку", "Поиск", "Всего по: ООО ЗСТ")
    Set rngStart = Cells.Find(What:=strStart, After:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Set rngEnd = ActiveSheet.Cells.Find(What:=strEnd, After:=rngStart, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Range(rngStart, rngEnd).EntireRow.Select
    Set rngStart = Nothing
    Set rngEnd = Nothing
    
End Sub

ручную удалить по всему документу очень долго »

Вероятно, так будет тоже не очень удобно, нужно помнить, что в ячейке именно ООО ЗСТ, а не скажем ООО "ЗСТ", а "Всего по: ООО ЗСТ" не будет записано "Итого по: ООО ЗСТ" или "Всего по : ООО ЗСТ" (в последнем случае перед двоеточием пробел).
Соответственно - поиск нужен по всей книге, или достаточно текущего листа?

[Swit0]

или достаточно текущего листа? »

Достаточно.

Попробуйте код ниже »

Я дико извиняюсь, мне с этим кодом сделать что? К своему позору, я не знаю.

[a_axe]

В экселе нажмите alt+f11, откроется окно редактора VBA. В левой части найдите thisworkbook, щелкните по нему два раза, чтобы открылось его содержимое (пустой белый лист). Скопируйте код туда (при копировании раскладка должна стоять русская, иначе латиница кириллица может потеряться) , щелкните курсором на любой строчке, после чего можно запустить из редактора по F5,, либо из Excel по alt+F8. К сожалению нет возможности сделать скриншот.

[okshef]

с этим кодом сделать что? »

Как вставить готовый макрос в рабочую книгу? - инструкция в картинках. Код - из темы

[Swit0]

Добрый день! Спасибо, получилось. А если мне нужно указать несколько организаций через запятую, без поиска. Т.е например надо выделить ООО ЗСТ, потом ООО ДБГ, и таких несколько, то как поступить? Заранее спасибо.

[a_axe]

А если мне нужно указать несколько организаций через запятую, без поиска »

Swit0, я обычно выступаю за визуальный контроль того, что делает программа. Предлагаю такой вариант: перечень организаций вы вводите через запятую+пробел, запускаете код ниже. Код присваивает найденным диапазонам имена, которые вы можете выбрать либо в окне имя (которое находится левее окна формул, чуть выше ячейки А1 - рядом с адресом выделенной ячейки есть стрелочка, нажав на которую вы получите список именованных диапазонов), либо через горячую клавишу F5. Диапазон по этому действию выделяется, дальше вы его аналогично удаляете (либо оставляете). Если код не найдет какой-то запрос, после выполнения он выбросит окно.

Код:

Public Sub naming_for_deleting()
    Dim rngStart As Range, rngEnd As Range, i As Integer
    Dim strStart As String, strEnd As String, strF As String, strErr As String, vrtTxt As Variant
    strF = InputBox("Введите через запятую (с пробелом) перечень", "Поиск", "ООО ЗСТ, ООО ВВВВ, ООО ООО, ООО МММ")
    vrtTxt = Split(strF, ", ")
    On Error Resume Next
    For i = LBound(vrtTxt) To UBound(vrtTxt)
        strStart = vrtTxt(i)
        strEnd = "Всего по: " & vrtTxt(i)
        Set rngStart = Cells.Find(What:=strStart, After:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set rngEnd = ActiveSheet.Cells.Find(What:=strEnd, After:=rngStart, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Err.Number <> 0 Then
            strErr = strErr & strStart & ","
            Err.Clear
        Else
            ActiveWorkbook.Names.Add Name:=Replace(strStart, " ", "_"), RefersTo:="=" & ActiveSheet.Name & "!" & Range(rngStart, rngEnd).EntireRow.Address
        End If
        
        Set rngStart = Nothing
        Set rngEnd = Nothing
    Next i
    
    If strErr <> "" Then MsgBox "Не найдены следующие запросы:" & strErr
    
    
End Sub

Удаляете вы все также сочетанием ctrl+знак минуса, но беда в том, что при удалении диапазона его имя все равно останется в рабочей книге со значением ошибки. Это не смертельно, но лучше эти имена удалять, например с помощью кода ниже (удалит все доступные имена с ошибкой, не затрагивая правильные имена).

Код:

Public Sub del_names_err()
    Dim namObj As Name
    For Each namObj In ActiveWorkbook.Names
        If namObj.RefersTo Like "*[#]REF[!]*" Then namObj.Delete
    Next
End Sub

[Swit0]

a_axe, благодарствую! А возможно ли сразу выделить диапазон организаций? Т.е имитация того, что если бы я их с CTRL мышкой выделял. Потом глазами пробегу по документу, если ок, то CTRL минус. Конечная цель - очистить документ от ненужных организаций.

[a_axe]

сразу выделить диапазон организаций? »

Попробуйте код ниже:

Код:

Public Sub select_all_for_deleting()
    Dim rngStart As Range, rngEnd As Range, i As Integer, rngAll As Range
    Dim strStart As String, strEnd As String, strF As String, strErr As String, vrtTxt As Variant
    strF = InputBox("Введите через запятую (с пробелом) перечень", "Поиск", "ООО ЗСТ, ООО ВВВВ, ООО ООО, ООО МММ")
    vrtTxt = Split(strF, ", ")
    On Error Resume Next
    For i = LBound(vrtTxt) To UBound(vrtTxt)
        strStart = vrtTxt(i)
        strEnd = "Всего по: " & vrtTxt(i)
        Set rngStart = Cells.Find(What:=strStart, After:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set rngEnd = ActiveSheet.Cells.Find(What:=strEnd, After:=rngStart, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Err.Number <> 0 Then
            strErr = strErr & strStart & ","
            Err.Clear
        Else
            If rngAll Is Nothing Then Set rngAll = Range(rngStart, rngEnd).EntireRow Else Set rngAll = Union(rngAll, Range(rngStart, rngEnd).EntireRow)
        End If
        
        Set rngStart = Nothing
        Set rngEnd = Nothing
    Next i
    
    If strErr <> "" Then MsgBox "Не найдены следующие запросы:" & strErr
    rngAll.Select
    Set rngAll = Nothing
End Sub

[Swit0]

a_axe, добрый день, спасибо. К сожалению, как оказалось в дальнейшем форма отчета меняется, там уже нет графы "Всего по:" и дифференцировать организацию не удастся. Она начинается с заголовка уже другой организации.