Удаление связей в MS Excel

От: Master F1

Причин для удаления может быть несколько: файл отправлен по почте, перемещён на другой компьютер, подгружен в какую-либо систему и т.д.

1 способ

Самый простой способ – это разорвать связь. Вкладка «Данные» — «Изменить связи». В открывшемся окне разорвать ненужные связи

Этот способ работает не всегда и иногда связи остаются

2 способ

Следует проверить «Диспетчер имен» и убрать там лишние записи. Открыть его можно используя горячие клавиши Ctrl+F3

3 способ

Когда имён нет, но проблема остаётся. На вкладке «Главная» — «Условное форматирование» выбираем пункт «Управление правилами»

Может получиться, что правил очень много и просмотреть их все проблематично. К тому же не факт, что найдём, что ищем

4 способ

Можно проверить ячейки, содержащие разные правила

«Найти и выделить» — «Выделить группу ячеек» — в открывшемся окне отметить «Проверка данных»

Выделяются ячейки, которые содержат какие-либо правила, настройки или связи. Тоже может быть очень много

Можно через эту кнопку:

Находим подсвеченные ячейки и проверяем их корректность

Жмём выделенную «сомнительную» ячейку и открываем проверку данных

В моём случае там какая-то левая ссылка

Удаляем содержимое

Ставим тип «Любое значение»

Снова пробуем удалить связь

Рабочий способ, но если и это не прокатило, то идём дальше

5 способ

На разных форумах пользователи делятся своими методами решения проблемы и приводят примеры макросов. Сначала включаем возможности разработчиков

«Параметры» – «лента» — включаем вкладку «Разработчик»

Теперь можем писать макросы

1 вариант

Sub УдалитьСсылки()
   Dim iLink
   On Error Resume Next
   For Each iLink In ActiveWorkbook.LinkSources(xlExcelLinks)
       ActiveWorkbook.BreakLink iLink, xlExcelLinks
   Next
   On Error GoTo 0
End Sub

Sub УдалитьСсылки()

Dim iLink

On Error Resume Next

For Each iLink In ActiveWorkbook.LinkSources(xlExcelLinks)

ActiveWorkbook.BreakLink iLink, xlExcelLinks

On Error GoTo 0

End Sub

2 вариант

Sub CopyWithoutRef()  
'Dim tm!: tm = Timer  
Dim r As Range, s As String, nm As Name  
With Application  
   .ScreenUpdating = 0: .Calculation = xlCalculationManual  
End With  
ActiveSheet.Copy After:=ActiveSheet  
With ActiveSheet  
   For Each r In .UsedRange.SpecialCells(xlCellTypeFormulas).Cells  
       s = r.Formula  
       If InStr(1, s, "!", vbTextCompare) Then  
           r.Value = r.Value  
       Else  
           For Each nm In ThisWorkbook.Names  
               If InStr(1, s, nm.Name, vbTextCompare) Then r.Value = r.Value: Exit For  
           Next nm  
       End If  
   Next r  
End With  
With Application  
   .ScreenUpdating = 1: .Calculation = xlCalculationAutomatic  
End With  
'MsgBox Timer - tm  
End Sub

Sub CopyWithoutRef()

'Dim tm!: tm = Timer

Dim r As Range, s As String, nm As Name

With Application

.ScreenUpdating = 0: .Calculation = xlCalculationManual

End With

ActiveSheet.Copy After:=ActiveSheet

With ActiveSheet

For Each r In .UsedRange.SpecialCells(xlCellTypeFormulas).Cells

s = r.Formula

If InStr(1, s, "!", vbTextCompare) Then

r.Value = r.Value

Else

For Each nm In ThisWorkbook.Names

If InStr(1, s, nm.Name, vbTextCompare) Then r.Value = r.Value: Exit For

Next nm

End If

Next r

End With

With Application

.ScreenUpdating = 1: .Calculation = xlCalculationAutomatic

End With

'MsgBox Timer - tm

End Sub

3 вариант

Sub www()  
   Dim c As Range, f$  
   On Error Resume Next  
   With ActiveSheet.UsedRange  
       Set c = .Find(What:="!", LookIn:=xlFormulas, _  
                     LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)  
       If Not c Is Nothing Then  
           f = c.Address  
           Do  
               c.Value = c.Value  
               Set c = .FindNext©  
           Loop While Not c Is Nothing And c.Address &lt;&gt; f  
       End If  
   End With  
End Sub