Цитата:
Цитата Swit0
А если мне нужно указать несколько организаций через запятую, без поиска »
|
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
|
