Option Explicit
'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
' Профессиональная разработка приложений для MS Office любой сложности
' Проведение тренингов по MS Excel
' https://www.excel-vba.ru
' info@excel-vba.ru
' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose:
'---------------------------------------------------------------------------------------
Sub FindErrLink()
'надо посмотреть в Данные -Изменить связи ссылку на файл-иточник
'и записать сюда ключевые слова в нижнем регистре(часть имени файла)
'звездочка просто заменяет любое кол-во символов, чтобы не париться с точным названием
Const sToFndLink$ = "*продажи 2018*"
Dim rr As Range, rc As Range, rres As Range, s$
'определяем все ячейки с проверкой данных
On Error Resume Next
Set rr = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
If rr Is Nothing Then
MsgBox "На активном листе нет ячеек с проверкой данных", vbInformation, "www.excel-vba.ru"
Exit Sub
End If
On Error GoTo 0
'проверяем каждую ячейку на предмет наличия связей
For Each rc In rr
'на всякий случай пропускаем ошибки - такое тоже может быть
'но наши связи должны быть без них и они точно отыщутся
s = ""
On Error Resume Next
s = rc.Validation.Formula1
On Error GoTo 0
'нашли - собираем все в отдельный диапазон
If LCase(s) Like sToFndLink Then
If rres Is Nothing Then
Set rres = rc
Else
Set rres = Union(rc, rres)
End If
End If
Next
'если связь есть - выделяем все ячейки с такими проверками данных
If Not rres Is Nothing Then
rres.Select
' rres.Interior.Color = vbRed 'если надо выделить еще и цветом
End If
End Sub