如何使用VBA識別Excel ListObject表的計算列公式

Question

我遇到了提供外部參考警告的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對象模型內部訪問它？

Answer 1

我意識到你可以讓Excel通過向ListObject添加一行來顯示幻像計算公式。在不影響現有數據的情況下添加行的最安全方法是將表複製到臨時表中，然後在新表中調整listObject的大小。

我已經添加下面我現有的查詢從原來的問題，提取所有隱藏forumla和引用：

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