如何使用 VBA 识别 Excel ListObject 表的计算列公式答案

【问题标题】：How to identify Calculated Column Formulas for Excel ListObject tables using VBA如何使用 VBA 识别 Excel ListObject 表的计算列公式
【发布时间】：2017-11-22 10:21:24
【问题描述】：

我遇到了一个 Excel 工作簿问题，它给出了外部参考警告。 Excel 提供了中断这些引用的选项，但没有提供任何方法来识别引用的位置。

在工作簿的每张纸上运行错误检查实用程序后，我最终发现了该参考。它隐藏在表格对象中。引用未包含在数据连接或公式中。它不能通过普通的 Ctrl+F 类型 Find 搜索来搜索，我也找不到它包含在任何 VBA 对象中。

如果您创建表对象，然后将公式添加到列（具有外部引用），然后手动将每行中的公式替换为其他内容，则会发生引用。 Excel 在文件中的某处保留原始公式。我尝试访问与表对应的 ListObject 的各种属性、包含列的范围、包含公式的 ListObject 的 ListColumn 以及许多其他属性。

引用在文件中的某处，可以通过单击单元格的公式错误警告并选择“恢复到计算列公式”来显示。

有没有办法用 VBA 或其他方式系统地找到这些隐藏的引用？

编辑 1：

我编写了以下脚本来搜索各种不同的对象以查找对外部源的隐藏引用，但没有找到包含此类引用的对象。

Sub ListLinks()

Dim wb As Workbook
Set wb = Application.ActiveWorkbook

' Identify any links to external workbooks
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    wb.Sheets.Add
    xIndex = 1
    For Each link In wb.LinkSources(xlExcelLinks)
        Application.ActiveSheet.Cells(xIndex, 1).Value = link
        xIndex = xIndex + 1
    Next link
End If

Dim outSheet As Worksheet
Set outSheet = wb.Worksheets.Add

' Extract all hidden references into a searchable sheet
Dim ws As Worksheet
Dim sh As Shape
With Range("A1:D1")
    .Value = Array("ObjectType", "Parent", "ObjectName", "Reference")
    .Interior.Color = xlColor1
    .Font.Color = xlColor2
End With

' All shape objects can have an action assigned that may be in another workbook
i = 2
For Each ws In Worksheets
    For Each sh In ws.Shapes
        outSheet.Cells(i, 1).Value = "Shape"
        outSheet.Cells(i, 2).Value = ws.Name
        outSheet.Cells(i, 3).Value = sh.Name
        outSheet.Cells(i, 4).Value = "'" & sh.OnAction
        i = i + 1
    Next
Next

' All name references may point to a range or table in another workbook
Dim nm As Name
For Each nm In ActiveWorkbook.Names
    outSheet.Cells(i, 1).Value = "Name"
    outSheet.Cells(i, 3).Value = nm.Name
    outSheet.Cells(i, 4).Value = "'" & nm.RefersTo
    i = i + 1
Next

' All chart series and chart shapes can contain references
Dim ch As Chart
Dim srs As Series
For Each ch In ActiveWorkbook.Charts
    For Each srs In ch.SeriesCollection
        outSheet.Cells(i, 1).Value = "ChartsSeries"
        outSheet.Cells(i, 2).Value = ch.Name
        outSheet.Cells(i, 3).Value = srs.Name
        outSheet.Cells(i, 4).Value = "'" & srs.Formula
        i = i + 1
    For Each sh In ch.Shapes
        outSheet.Cells(i, 1).Value = "ChartsShapes"
        outSheet.Cells(i, 2).Value = ch.Name
        outSheet.Cells(i, 3).Value = sh.Name
        outSheet.Cells(i, 4).Value = "'" & sh.OnAction
        i = i + 1
    Next
    Next
Next

' As above, but for charts in a Worksheet, previous was for Chart Sheets
Dim chOb As ChartObject
For Each ws In Worksheets
    For Each chOb In ws.ChartObjects
        For Each srs In chOb.Chart.SeriesCollection
            outSheet.Cells(i, 1).Value = "ChartsObjectsSeries"
            outSheet.Cells(i, 2).Value = ws.Name & " | " & ch.Name
            outSheet.Cells(i, 3).Value = srs.Name
            outSheet.Cells(i, 4).Value = "'" & srs.Formula
            i = i + 1
        Next
        For Each sh In chOb.Chart.Shapes
            outSheet.Cells(i, 1).Value = "ChartsObjectsShapes"
            outSheet.Cells(i, 2).Value = ws.Name & " | " & ch.Name
            outSheet.Cells(i, 3).Value = sh.Name
            outSheet.Cells(i, 4).Value = "'" & sh.OnAction
            i = i + 1
        Next
    Next
Next

' Query tables can reference external sheets
Dim qryTbl As QueryTable
For Each ws In Worksheets
    For Each qryTbl In ws.QueryTables
        outSheet.Cells(i, 1).Value = "QueryTables"
        outSheet.Cells(i, 2).Value = ws.Name
        outSheet.Cells(i, 3).Value = qryTbl.Name
        outSheet.Cells(i, 4).Value = "'" & qryTbl.Connection
        i = i + 1
    Next
Next

Dim lstObj As ListObject
For Each ws In Worksheets
    For Each lstObj In ws.ListObjects
    For Each qryTbl In lstObj.QueryTables
        outSheet.Cells(i, 1).Value = "TableQueryTables"
        outSheet.Cells(i, 2).Value = ws.Name & " | " & lstObj.Name
        outSheet.Cells(i, 3).Value = qryTbl.Name
        outSheet.Cells(i, 4).Value = "'" & qryTbl.Connection
        i = i + 1
    Next
Next

' OLEObjects such as images can point to external sources
Dim oleOb As OLEObject
For Each ws In Worksheets
    For Each oleOb In ws.OLEObjects
        outSheet.Cells(i, 1).Value = "OLEObjects"
        outSheet.Cells(i, 2).Value = ws.Name
        outSheet.Cells(i, 3).Value = oleOb.Name
        outSheet.Cells(i, 4).Value = "'" & oleOb.SourceName
        i = i + 1
    Next
Next

' Hyperlinks can point to external sources
Dim hypLk As Hyperlink
For Each ws In Worksheets
    For Each hypLk In ws.Hyperlinks
        outSheet.Cells(i, 1).Value = "HyperLinks"
        outSheet.Cells(i, 2).Value = ws.Name
        outSheet.Cells(i, 3).Value = hypLk.Name
        outSheet.Cells(i, 4).Value = "'" & hypLk.SubAddress
        i = i + 1
    Next
Next

End Sub

编辑 2：

从 Slai 的评论中，我可以看到 /xl/tables/table1.xml 中文件的 XML 内的引用，在

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<table xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" id="1" name="Table1" displayName="Table1" ref="A1:B4" totalsRowShown="0">
    <autoFilter ref="A1:B4"/>
    <tableColumns count="2">
        <tableColumn id="1" name="a"/>
        <tableColumn id="2" name="b" dataDxfId="0">
            <calculatedColumnFormula>[1]Sheet1!$A2</calculatedColumnFormula>
        </tableColumn>
    </tableColumns>
    <tableStyleInfo name="TableStyleMedium2" showFirstColumn="0" showLastColumn="0" showRowStripes="1" showColumnStripes="0"/>
</table>

有没有办法从 VBA 对象模型内部访问它？

【问题讨论】：

它是否列在数据选项卡 > 编辑链接中？它也可能在控件上，因为它们无法使用 Ctrl+F 进行搜索
是的，但是从那里，我无法找到引用的位置。
support.office.com/en-us/article/…
感谢 Slai，我已经研究过那个，我给出的示例并未包含在该文档中列出的任何场景中
那么我唯一能想到的就是解压 .xlsx 文件并搜索其中的 .xml 文件

标签： xml excel vba

【解决方案1】：

我意识到您可以通过在 ListObject 中添加一行来让 Excel 显示虚拟计算公式。在不影响现有数据的情况下添加行的最安全方法是将表复制到临时工作表中，然后在新工作表中调整 listObject 的大小。

我已将以下内容添加到来自原始问题的现有查询中，以提取所有隐藏的论坛和参考资料：

Dim tmpSht As Worksheet
For Each ws In Worksheets
    For Each lstObj In ws.ListObjects
        Set tmpSht = Sheets.Add
        lstObj.Range.Copy
        tmpSht.Range("A1").PasteSpecial
        tmpSht.ListObjects(1).Resize tmpSht.ListObjects(1).Range.Resize(lstObj.Range.Rows.Count + 1, lstObj.Range.Columns.Count)
        For j = 1 To lstObj.ListColumns.Count
            outSheet.Cells(i, 1).Value = "Table ListObjects - Calculated Formulas"
            outSheet.Cells(i, 2).Value = ws.Name & " | " & lstObj.Name
            outSheet.Cells(i, 3).Value = lstObj.ListColumns(j).Name
            outSheet.Cells(i, 4).Value = "'" & Cells(tmpSht.ListObjects(1).Range.Rows.Count, j).Formula
            i = i + 1
        Next
        Application.DisplayAlerts = False
        tmpSht.Delete
        Application.DisplayAlerts = True
    Next
Next

随后，我现在找到了具有类似解决方案的以下问题： https://stackoverflow.com/a/40734667/2341820

【讨论】：