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

时间:2017-06-20 03:42:31

标签: xml excel vba

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

我最终在工作簿的每个工作表上运行错误检查实用程序后发现了引用。它隐藏在一个表对象中。引用未包含在数据连接或公式中。它不能通过普通的Ctrl + F类型查找搜索进行搜索,也不能在任何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对象模型中访问它?

1 个答案:

答案 0 :(得分:1)

我已经意识到你可以让Excel通过向ListObject添加一行来显示幻像计算公式。在不影响现有数据的情况下添加行的最安全方法是将表复制到临时表中,然后在新表中调整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