Удалить все кроме нужных именованные диапазоны

Дата: Четверг, 01.04.2021, 16:23 | Сообщение № 1

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Добрый день, всем участникам форума!
Прошу оказать содействие в правки моего кода "Франкенштейна":
[vba]

Код

Sub DeleteExternalNames()
'отображаем скрытые имена
Dim nName As Name
For Each nName In ActiveWorkbook.Names
nName.Visible = True
Next nName
'удаляем лишние имена
Dim n As Name
For Each n In Application.ActiveWorkbook.Names
n.Delete
count = count + 1
Next n
MsgBox "Все имена в количестве " & count & " удалены"
End Sub

[/vba]
Этим кодом отображаю все скрытые имена и потом удаляю все именованные диапазона (т.к. при копировании листа всем известно что происходит с тысячами имен).
Но в некоторых файлах есть нужные именованные диапазоны (списки, умные таблицы, созданные в этой книге).
Попытался удалить только имена с ошибками:
[vba]

Код

For Each IName In ActiveWorkbook.Names
    If IName.RefersTo Like "*REF!*" Then
    IName.Delete 'удаление имени с ошибками
    End If
Next

[/vba]
Но остаются имена с внешними ссылками или системными (которые подтянулись из файлов 1С).
На одном из сайте нашел что можно сделать "Если n.referestorange существует, и если n.referstorange.worksheet.parent is thisworkbook, то не удалять", но не понял как это вкрутить в свой код.
Буду признателен за любой совет.

Дата: Четверг, 01.04.2021, 16:33 | Сообщение № 2

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Пустой файл с лишними именованными диапазонами весит почти метр. Сделал архив из двух файлов

К сообщению приложен файл: __--part1.rar (500.0 Kb) · __--part2.rar (363.5 Kb)

Дата: Четверг, 01.04.2021, 18:49 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 19179

Репутация: 4419 ±

Замечаний: ±

Excel 365 & Mac Excel

Попробуйте такой вариант, только сначала на копии файла)
[vba]

Код

Sub DeleteExternalNames()
'отображаем скрытые имена
    Dim nName As Name
    For Each nName In ThisWorkbook.Names
        nName.Visible = True
    Next nName
    'удаляем лишние имена
    Dim n As Name, count As Long
    On Error Resume Next
    For Each n In ThisWorkbook.Names
        If InStr(n.RefersTo, "#") > 0 Or InStr(n.RefersTo, "\\") > 0 Then
            n.Delete
            count = count + 1
        ElseIf Not n.RefersToRange.Worksheet.Parent Is ThisWorkbook Then
            n.Delete
            count = count + 1
        End If
    Next n
    MsgBox "Все имена в количестве " & count & " удалены"
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 01.04.2021, 20:16 | Сообщение № 4

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Pelena,
Даже с решением. Спасибо Вам, попробую

Дата: Четверг, 01.04.2021, 21:30 | Сообщение № 5

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Pelena,
Не срабатывает код. Буквально сразу после запуска выводится сообщение msgbox "Все имена в количестве 0 удалены"
Получается сразу отрабатывается строка[vba]

Код

On Error Resume Next

[/vba]

Сообщение отредактировал Anis625 - Четверг, 01.04.2021, 21:47

Дата: Четверг, 01.04.2021, 22:05 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 19179

Репутация: 4419 ±

Замечаний: ±

Excel 365 & Mac Excel

Вот, что стало с Вашим файлом-примером, который

Цитата Anis625, 01.04.2021 в 16:33, в сообщении № 2 ()

весит почти метр

после работы макроса. Как видите размер резко уменьшился

К сообщению приложен файл: __--.xlsm (27.4 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 01.04.2021, 22:26 | Сообщение № 7

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Pelena,
Странное дело - поместил код в "Личную книгу макросов" не работает. Поместил в модуль книги - работает. Из-за чего может быть так?
На счет размера - согласен, что в этом и была причина такого веса, поэтому и пытался решить задачку.

Дата: Четверг, 01.04.2021, 22:32 | Сообщение № 8

Группа: Админы

Ранг: Местный житель

Сообщений: 19179

Репутация: 4419 ±

Замечаний: ±

Excel 365 & Mac Excel

Если в личной книге макросов, надо заменить ThisWorkbook на ActiveWorkbook

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 01.04.2021, 22:40 | Сообщение № 9

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Pelena,
Все отлично работает после замены. Спасибо Вам огромное.
Маленький (не критичный нюанс) только уточню. Код не отработал две ошибки (фото во вложении) из-за чего это может быть?

К сообщению приложен файл: 9304641.png (12.7 Kb)

Дата: Четверг, 01.04.2021, 22:51 | Сообщение № 10

Группа: Админы

Ранг: Местный житель

Сообщений: 19179

Репутация: 4419 ±

Замечаний: ±

Excel 365 & Mac Excel

Удалите область печати с листа. Должно помочь.
Да и две ошибки можно и вручную удалить)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 01.04.2021, 22:57 | Сообщение № 11

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Pelena,
Пусто там. И при копировании листа именно на них и выводится сообщение о конфликте имен.
В них вроде есть символ # который указан в коде, по идее должен снести и его тоже код

К сообщению приложен файл: 0590472.png (20.7 Kb)

Дата: Четверг, 01.04.2021, 23:15 | Сообщение № 12

Группа: Заблокированные

Ранг: Ветеран

Сообщений: 674

Репутация: 31 ±

Замечаний: 20% ±

Excel 2013

Pelena,
Марокодером записал действие удаления например заголовков печати:[vba]

Код

ActiveWorkbook.Names("Print_Titles").Delete

[/vba]
После запуска отдельно этого кода - не удаляет. Странно