Обнаружение ссылки на ячейку из других книг?

Есть ли способ с VBA и/или некоторой формулой в Excel, чтобы проверить, есть ли другие книги/листы, ссылающиеся на ячейку? В идеале, также из каких книг/листов, но если это невозможно, это тоже нормально.

Допустим, у меня есть книга со списком прокси-адресов, я хочу знать, используется ли прокси-сервер, проверяя, есть ли какая-либо другая книга, ссылающаяся на ее ячейку. Это должно иметь индикатор того, является ли он свободным прокси-сервером или уже используется.

Любое альтернативное решение, которое близко к этому, также приветствуется. Я сам по себе не ищу полномасштабное решение, но я могу зайти далеко, указав на меня в правильном направлении.

Ответ 1

Вот какой-то код, есть какой-то установочный код, чтобы вы (или другие соавторы) могли запускать пример из двух книг, один из которых указывал на другой. Две книги будут сохранены в вашем каталоге Temp как часть настройки.

Для меня выход

 Cell at Book2.xlsx!Sheet1!$A$2 has external workbook source of [Book1.xlsx]

Он работает, исследуя LinkSources для рабочей книги, а затем просматривает ячейки, которые ищут этот источник ссылок.

Option Explicit



'---------------------------------------------------------------------------------------
' Procedure : Investigate
' DateTime  : 06/02/2018 14:40
' Author    : Simon
' Purpose   : Start execution here.  There is some setup code
'---------------------------------------------------------------------------------------
' Arguments :
'    arg1      : arg1 description
'
Sub Investigate()

    '**************************************************
    ' START of Experiment setup code
    '**************************************************
    Dim wb1 As Excel.Workbook, wb2 As Excel.Workbook

    GetOrCreateMyTwoWorbooks "Book1", "SimonSub1", wb1, "Book2", "SimonSub2", wb2


    wb1.Worksheets(1).Range("a1").Formula = "=2^4"


    wb2.Worksheets(1).Range("a1").Formula = "=2^2"
    wb2.Worksheets(1).Range("b1").Formula = "=3^2"
    wb2.Worksheets(1).Range("a2").FormulaR1C1 = "=[" & wb1.Name & "]Sheet1!R1C1/r1c1*r1c2"

    '**************************************************
    ' END of Experiment setup code
    '**************************************************

    '**************************************************
    '* now the real logic begins
    '**************************************************

    Dim dicLinkSources As Scripting.Dictionary
    Set dicLinkSources = LinkSources(wb2)

    '* get all the cells containing formulae in the worksheet we're interested in
    Dim rngFormulaCells As Excel.Range
    Set rngFormulaCells = wb2.Worksheets(1).UsedRange.SpecialCells(xlCellTypeFormulas)

    '* set up results container (one could report as we find them but I like to collate)
    Dim dicExternalWorksheetPrecedents As Scripting.Dictionary
    Set dicExternalWorksheetPrecedents = New Scripting.Dictionary

    '* loop throught the subset of cells on the worksheet that have formulae
    Dim rngFormulaCellsLoop As Excel.Range
    For Each rngFormulaCellsLoop In rngFormulaCells

        Dim sFormula As String
        sFormula = rngFormulaCellsLoop.Formula  '* I like a copy in my locals window

        '* search for all the link sources (experiment has only one, chance are you'll have many)
        Dim vSearchLoop As Variant
        For Each vSearchLoop In dicLinkSources.Items
            If VBA.InStr(1, sFormula, vSearchLoop, vbTextCompare) > 0 Then

                '* we found one, add to collated results
                dicExternalWorksheetPrecedents.Add wb2.Name & "!" & wb2.Worksheets(1).Name & "!" & rngFormulaCellsLoop.Address, vSearchLoop

            End If
        Next vSearchLoop

    Next

    '*print collated results
    Dim lResultLoop As Long
    For lResultLoop = 0 To dicExternalWorksheetPrecedents.Count - 1
        Debug.Print "Cell at " & dicExternalWorksheetPrecedents.Keys()(lResultLoop) & " has external workbook source of " & dicExternalWorksheetPrecedents.Items()(lResultLoop)

    Next lResultLoop


    Stop
End Sub

'---------------------------------------------------------------------------------------
' Procedure : LinkSources
' DateTime  : 06/02/2018 14:38
' Author    : Simon
' Purpose   : To acquire list of link sources and more importantly the search term
'             we're going to see to look for external workbooks
'---------------------------------------------------------------------------------------
' Arguments :
'   [in] wb         : The workbook we want report on
'   [out,retval]    : returns a dictionary with the lik sources in the keys and search term in item
'
Function LinkSources(ByVal wb As Excel.Workbook) As Scripting.Dictionary

    Static fso As Object
    If fso Is Nothing Then Set fso = VBA.CreateObject("Scripting.FileSystemObject")

    Dim dicLinkSources As Scripting.Dictionary
    Set dicLinkSources = New Scripting.Dictionary

    Dim vLinks As Variant
    vLinks = wb.LinkSources(XlLink.xlExcelLinks)

    If Not IsEmpty(vLinks) Then
        Dim lIndex As Long
        For lIndex = LBound(vLinks) To UBound(vLinks)

            Dim sSearchTerm As String
            sSearchTerm = ""

            If fso.FileExists(vLinks(lIndex)) Then
                Dim fil As Scripting.file
                Set fil = fso.GetFile(vLinks(lIndex))

                '* this is what we'll search for in the cell formulae
                sSearchTerm = "[" & fil.Name & "]"

            End If

            dicLinkSources.Add vLinks(lIndex), sSearchTerm

        Next lIndex
    End If
    Set LinkSources = dicLinkSources
End Function


'*****************************************************************************************************************
'                                         __                                __
'_____  ______ ___________ ____________ _/  |_ __ __  ______   ______ _____/  |_ __ ________
'\__  \ \____ \\____ \__  \\_  __ \__  \\   __\  |  \/  ___/  /  ___// __ \   __\  |  \____ \
' / __ \|  |_> >  |_> > __ \|  | \// __ \|  | |  |  /\___ \   \___ \\  ___/|  | |  |  /  |_> >
'(____  /   __/|   __(____  /__|  (____  /__| |____//____  > /____  >\___  >__| |____/|   __/
'     \/|__|   |__|       \/           \/                \/       \/     \/           |__|
'
'*****************************************************************************************************************
'* this is just something to setup the experiment, you won't need this hence the big banner  :)
'*
Public Sub GetOrCreateMyTwoWorbooks(ByVal sWbName1 As String, ByVal sSubDirectory1 As String, ByRef pwb1 As Excel.Workbook, _
                                    ByVal sWbName2 As String, ByVal sSubDirectory2 As String, ByRef pwb2 As Excel.Workbook)

    Static fso As Object
    If fso Is Nothing Then Set fso = VBA.CreateObject("Scripting.FileSystemObject")

    On Error Resume Next
    Set pwb1 = Application.Workbooks.Item(sWbName1)
    Set pwb2 = Application.Workbooks.Item(sWbName2)
    On Error GoTo 0

    If pwb1 Is Nothing Then
        Set pwb1 = Application.Workbooks.Add

        Dim sSubDir1 As String
        sSubDir1 = fso.BuildPath(Environ$("tmp"), sSubDirectory1)

        If Not fso.FolderExists(sSubDir1) Then fso.CreateFolder (sSubDir1)

        Dim sSavePath1 As String
        sSavePath1 = fso.BuildPath(sSubDir1, sWbName1)

        pwb1.SaveAs sSavePath1
    End If

    If pwb2 Is Nothing Then
        Set pwb2 = Application.Workbooks.Add

        Dim sSubDir2 As String
        sSubDir2 = fso.BuildPath(Environ$("tmp"), sSubDirectory2)

        If Not fso.FolderExists(sSubDir2) Then fso.CreateFolder (sSubDir2)


        Dim sSavePath2 As String
        sSavePath2 = fso.BuildPath(sSubDir2, sWbName2)

        pwb2.SaveAs sSavePath2
    End If


End Sub

Ответ 2

На ленте> Формулы> Прецеденты трассировки> Нажмите:

Он расскажет вам следующие ячейки прецедента:

ячейки из текущей рабочей таблицы
ячейки из разных листов
ячейки из открытых книг

Если вы хотите увидеть, что элементы из более чем 1 ячейки учитывают следующее:

Sub TestMe()
    Dim myCell  As Range
    For Each myCell In ActiveSheet.UsedRange
        If myCell.HasFormula Then myCell.ShowPrecedents
    Next myCell
End Sub

Тогда вы можете получить что-то вроде этого: