Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Собития при копировании листов
 
#1
15.10.2020 20:24:13
Здравствуйте форумчаны, у меня такая ситуация : есть файлик который внутри есть 6000+ именованные диапазоны, при чем все ошибочные. От куда они взялись незнаю, но у наших фирме все ексел файли "заразились" этими именованные диапазоными. Это выглядит не катастрофично, НО! Если скопировать лист в книге, то эксел выдает ошибка конфликт имены и надо нажимать кнопку ОК около 10 минут!!! И поэтому хочу написать макрос, который при копирования листа обнаруживает ошибочные именованные диапазоны, и спросить удалит их или проста продолжить. Но к сожалению собития при копировани листа оказывается нету в VBA. Подскажите пожалуйста как можно реализовать это, заранее спасибо!
 
 
 
#2
15.10.2020 20:25:58
приложить файл-пример, удалив всю ценную информацию из него
P.S. Макросом удалить все битые имена. Макрос может работать долго...

Код
Sub DeleteNames()
Dim iName As Name
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error Resume Next
    For Each iName In ActiveWorkbook.Names
        If iName.RefersTo <> "<Object required>" Then
            'MsgBox iName.Value
            If InStr(1, iName.Value, "ССЫЛКА", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersToLocal, "=НД()", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersToLocal, "#ИМЯ?", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersTo, "REF!", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersTo, "C:\", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersTo, "\\", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersToLocal, "#Н/Д", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
            If InStr(1, iName.RefersTo, "#N/A", vbTextCompare) > 0 Then iName.Delete: GoTo Next_
        End If    
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Конец!", vbInformation, "Удаление имён"
End Sub
Изменено: New - 15.10.2020 20:28:26
 
 
 
Страницы: 1
Наверх