Отфильтровать ненужную информацию в Excel

[Swit0]

Здравствуйте! Возникла потребность в приложенном .xls документе сделать фильтрацию какого плана: например, от слов "ООО ЗСТ" до "Всего по: ООО ЗСТ" выделить строки и удалить их. Дело в том, что вручную удалить по всему документу очень долго, а документов таких множество, я ищу какое то средство автоматизации. Версия Excel 2016. Как это можно сделать ? Заранее спасибо!

[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]

с этим кодом сделать что? »
Как вставить готовый макрос в рабочую книгу? (https://www.e-xcel.ru/index.php/makrosy/kak-vstavit-gotovyj-makros-v-rabochuyu-knigu) - инструкция в картинках. Код - из темы

[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, добрый день, спасибо. К сожалению, как оказалось в дальнейшем форма отчета меняется, там уже нет графы "Всего по:" и дифференцировать организацию не удастся. Она начинается с заголовка уже другой организации.

[a_axe]

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