Vba列出所有外部链接 [英] Vba to list all external links

问题描述

你有任何VBA代码 列出工作簿中的所有外部链接

do you have any VBA CODE  to list all the external link in the workbook

具有源名称的类似内容以及使用外部链接的公式/对象/命名范围。

something like this with the source name and where are the formulas/objects/named ranges that uses the external links.

我需要每个公式地址旁边的源名称，因为我有数千个带外部链接的公式，我需要按来源过滤它们

I need the source name next to every formula address because I have thousands of formulas with external links and I need to filter them by the source

推荐答案

您好

您可以尝试以下工作代码。

You can try the following worked code.

Sub ListLinks（）

    Dim xSheet As Worksheet

    Dim xRg As Range

    Dim xCell As Range

    Dim xCount As Long

    Dim xLinkArr（）As String

    On Error Resume Next

   对于工作表中的每个xSheet

       设置xRg = xSheet.UsedRange.SpecialCells（xlCellTypeFormulas）

       如果xRg是Nothing那么GoTo LblNext

       对于每个xCell在xRg中
           如果InStr（1，xCell.Formula，"["]> 0然后

                xCount = xCount + 1

               使用ReDim保留xLinkArr（1至2，为1〜XCOUNT）

                xLinkArr（1，xCount）= xCell.Address（,,, True）

                 xLinkArr（2，xCount）="'" &安培; xCell.Formula

          结束如果

       下一个

LblNext：

   下一个

   如果xCount> 0然后

        Sheets.Add（Sheets（1））。Name =" Link Sheet"

       范围（"A1"）。调整大小（，2）.Value =数组（"位置"，"参考"）

       范围（" A2"）。调整（UBound函数（xLinkArr，2），UBound函数（xLinkArr，1））值= Application.Transpose（xLinkArr）

    &NBSP ;  列（"A：B"）。自动填充

   否则

        MsgBox"在活动工作簿中找不到链接。"，vbInformation，"KuTools for Excel"

   结束如果

结束子

Sub ListLinks()
    Dim xSheet As Worksheet
    Dim xRg As Range
    Dim xCell As Range
    Dim xCount As Long
    Dim xLinkArr() As String
    On Error Resume Next
    For Each xSheet In Worksheets
        Set xRg = xSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
        If xRg Is Nothing Then GoTo LblNext
        For Each xCell In xRg
            If InStr(1, xCell.Formula, "[") > 0 Then
                xCount = xCount + 1
                ReDim Preserve xLinkArr(1 To 2, 1 To xCount)
                xLinkArr(1, xCount) = xCell.Address(, , , True)
                xLinkArr(2, xCount) = "'" & xCell.Formula
           End If
        Next
LblNext:
    Next
    If xCount > 0 Then
        Sheets.Add(Sheets(1)).Name = "Link Sheet"
        Range("A1").Resize(, 2).Value = Array("Location", "Reference")
        Range("A2").Resize(UBound(xLinkArr, 2), UBound(xLinkArr, 1)).Value = Application.Transpose(xLinkArr)
        Columns("A:B").AutoFit
    Else
        MsgBox "No links were found within the active workbook.", vbInformation, "KuTools for Excel"
    End If
End Sub

如果您有任何其他更新，请随时告诉我。

Feel free let me know if you have any other update.

请记住点击"标记为答案"解决您的问题的回复，并点击"取消标记为答案"如果不。这对阅读此主题的其他社区成员有益。

Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread.

这篇关于Vba列出所有外部链接的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！