按照VLOOKUP和VBA

Question

形勢引用：

我有許多工作表一個Excel工作簿。 工作簿中的某些單元格通過vlookup引用另一個Excel文件（稱爲MasterData）。

一個工作表中的某些單元格（稱爲Worksheet A）引用了另一個工作表的其他單元格（稱爲Worksheet B）。並且Worksheet B中的單元格參考MasterData。

在第三張工作表中Worksheet C一些單元格直接引用MasterData。

我的任務是找到依賴關係結構。 因此，對於上面的例子應該給：

Worksheet A -> Worksheet B -> MasterData 
Worksheet C -> MasterData 

當然更高水平的連接（如Worksheet D - >Worksheet E - >Worksheet F - >MasterData

什麼我迄今所做的：

我遍歷所有的工作表，然後遍歷工作表的單元格。在迭代內部，我測試單元格是否有公式，如果公式包含MasterData我知道這個工作工作表參考文獻MasterData。

所以我已經拿到了第一級。

問題：

現在我有細胞樣：（比方說我在Worksheet1細胞B2）

=Worksheet2!A1 

而且電池A1在Worksheet2樣子：

='X:\[MasterData.xslm]FZE'!A8 

所以當我處理單元格Worksheet1!B2我想按照參考Worksheet2!A1，然後看到這參考MasterData。 我該如何做到這一點？

附錄

我提供我到目前爲止已經編寫的代碼。但它包含的內容比我所解釋的更多（它在MasterData中查找具體工作表）。

Sub Verknuepfungen_zwischen_Sheets_und_Masterdata() 

' Zeigt auf, mit welchem Sheet aus der Masterdata ein Sheet der Planung verknüpft ist 

Dim referenceToMaster As String 
referenceToMaster = "MASTERDATA-Sep2014.xlsm]" 

' schreibe Ausgabe in Analyse-Blatt 
Dim analysisSheet As Worksheet 
' finde dazu ein eventuell vorhandenes Analyse-Blatt 
If (SheetExists("Analyse-Blatt")) Then 
    Set analysisSheet = sheets("Analyse-Blatt") 
Else 
    Set analysisSheet = sheets.Add(before:=sheets(1)) 
    analysisSheet.Name = "Analyse-Blatt" 
End If 

worksheetCount = ActiveWorkbook.Worksheets.Count 

currentRowIndex = 1 
' Nun gehe jedes WorkSheet durch 
Dim sheetsInMaster As Collection 
Dim currentSheet As Worksheet 
For c = 2 To worksheetCount 
    Set currentSheet = sheets(c) 
    ' nur sichtbare durchschauen 
    If currentSheet.Visible = xlSheetVisible Then 
     ' nur die durchschauen, welche nicht schon Analyse-Blätter sind 
     If (InStr(currentSheet.Name, "Formeln_") = 0) Then 
      Set sheetsInMaster = New Collection 
      Set r1 = currentSheet.Range("a1", currentSheet.Range("a1").SpecialCells(xlLastCell)) 
      For Each cell In r1.Cells 
       ' schaue ob die Zelle eine Formel enthält 
       If cell.HasFormula Then 
        ' schaue ob Formel eine Verweis auf die Masterplanung enthält 
        If InStr(cell.formula, referenceToMaster) > 0 Then 
         ' füge den Bereich in der Masterplanung den sheetsInMaster hinzu 
         AddMasterSheets cell.formula, sheetsInMaster 
        End If 
       End If 
      Next cell 

      ' Ausgabe in Analyse-Blatt 
      If sheetsInMaster.Count > 0 Then 
       analysisSheet.Cells(currentRowIndex, 1) = currentSheet.Name 
       For Each sheetInMaster In sheetsInMaster 
        analysisSheet.Cells(currentRowIndex, 2) = sheetInMaster 
        currentRowIndex = currentRowIndex + 1 
       Next sheetInMaster 
      End If 
     End If 
    End If 
Next c 

End Sub 

Sub AddMasterSheets(ByVal formula As String, sheetsInMaster As Collection) 
    ' Fügt der Collection "sheetsInMaster" die Namen der Arbeitsblätter der Masterplanung hinzu, 
    ' auf welche in der "formula" verwiesen wird 
    Dim referenceToMaster As String 
    referenceToMaster = "MASTERDATA-Sep2014.xlsm]" 

    Dim currentIndexOfReferenceToMaster As Integer 
    Dim currentIndexOfPrime As Integer 
    currentIndexOfReferenceToMaster = InStr(formula, referenceToMaster) 
    Do While currentIndexOfReferenceToMaster <> 0 
     currentIndexOfPrime = InStr(currentIndexOfReferenceToMaster, formula, "'") 
     currentStart = currentIndexOfReferenceToMaster + Len(referenceToMaster) 
     sheetInMaster = Mid(formula, currentStart, currentIndexOfPrime - currentStart) 
     On Error Resume Next 
      sheetsInMaster.Add sheetInMaster, CStr(sheetInMaster) 
     On Error GoTo 0 

     currentIndexOfReferenceToMaster = InStr(currentIndexOfPrime, formula, referenceToMaster) 
    Loop 

End Sub 

Function SheetExists(sheetName As String) As Boolean 
' Gibt zurück, ob ein Arbeitsblatt mit dem Namen existiert 
    SheetExists = False 
    For Each ws In Worksheets 
    If sheetName = ws.Name Then 
     SheetExists = True 
     Exit Function 
    End If 
    Next ws 
End Function 

如果嘗試在工作簿這段代碼有兩個工作表名爲 「PlanningA」 和 「PlanningB」，其中在 「PlanningA」 的細胞是：

A1: =SVERWEIS($E4;'X:\[MASTERDATA-Sep2014.xlsm]Departments'!$G:$CF;AF$1238;FALSCH) 

A2: =AF4*'X:\[MASTERDATA-Sep2014.xlsm]Stammdaten'!AG$2*('X:\[MASTERDATA-Sep2014.xlsm]Stammdaten'!AG$15+'X:\[MASTERDATA-Sep2014.xlsm]Stammdaten'!AG$19)/60+(AF11*AF4) 

A3: =SVERWEIS($D4;'X:\[MASTERDATA-Sep2014.xlsm]Stammdaten'!$E$262:$CE$337;AF$1239;FALSCH)*8*AF4 

A4: =SVERWEIS($E4;'X:\[MASTERDATA-Sep2014.xlsm]Machinery'!$G:$CF;AF$1238;FALSCH) 

而在 「PlanningB」：

A1: =WENNFEHLER(SVERWEIS($E10;Werkebereich;BE$10000;FALSCH)*WVERWEIS($F10;'X:\[MASTERDATA-Sep2014.xlsm]FZE'!$3:$520;Montage!$D10-2;FALSCH);0)+WENNFEHLER(SVERWEIS($E10;Kitbereich;BE$10000;FALSCH)*WVERWEIS($F10;'X:\[MASTERDATA-Sep2014.xlsm]FZE'!$3:$520;Montage!$D10-2;FALSCH);0) 

A2: =SVERWEIS($E4;'X:\[MASTERDATA-Sep2014.xlsm]LKZ-Part'!$G:$CF;AF$1238;FALSCH) 

你會得到一個名爲「分析，布拉特」新的工作應該是這樣的：

|A   |B 
1|PlanningA |Departments 
2|   |Stammdaten 
3|   |Machinery 
4|PlanningB |FZE 
5|   |LKZ-Part 

這是第一級，所以我知道工作表PlanningA引用工作表Departments的MasterData。但正如您所看到的，PlanningB中的電池A1有一個VLookUp到Werkebereich。並且Werkebereich中的引用單元對中的表單具有各自的依賴關係。所以，我在找的是一個表，如：

|A   |B   |C 
1|PlanningA |Departments | 
2|   |Stammdaten | 
3|   |Machinery | 
4|PlanningB |Werkebreich | Employees 
5|   |FZE   | 
6|   |LKZ-Part | 

我希望我給了足夠的信息，以我什麼時候明白了，給我一個提示問題的解決方案：

如何在VBA中關注像VLOOKUP一樣的參考？

Answer 1

如果您有Office 365或Office Professional Plus 2013，那麼有一項稱爲Spreadsheet Enquire的功能非常強大，它完全符合您的需求並將其打印在一張漂亮的Web圖表中。更多信息 - 請看這裏：What you can do with Spreadsheet Inquire

Professional Plus 2013（我們公司有許可證）有更多像Spreadsheet Compare（我們用它來區分excel文件）這樣的程序，這很好。

Answer 2

這個工作適合你嗎？

我的測試工作簿有五個工作表。從Sheet1!A1開始，每個A1單元被鏈接到下一張紙上的A1單元格。在Sheet5!A1上只有一個值。因此，下面的代碼只是檢查與給定單元格關聯的公式是否爲引用，然後跟隨它直到結束並返回一個包含整個鏈的字符串。 （您可以用一個數組或逗號分隔的字符串或任何您需要的替換此字符串。）在下面的測試子單元格中，單元格Sheet1!A2只有一個簡單值（因此Formula爲空）。

Option Explicit 

Private cellRefChain As String 

Sub test() 
    Debug.Print ListCellReferenceChain(Sheets("Sheet1").Range("A2"), 0) 
    Debug.Print ListCellReferenceChain(Sheets("Sheet1").Range("D2"), 0) 
End Sub 

Function ListCellReferenceChain(startingCell As Range, level As Integer) As String 
    Dim thisCellReference As String 
    Dim destSheet As String 
    If level = 0 Then 
     cellRefChain = startingCell.Parent.Name & "!" & Replace(startingCell.Address, "$", "") 
    End If 
    destSheet = IsReference(startingCell.Formula) 
    If Len(destSheet) > 0 Then 
     thisCellReference = Right(startingCell.Formula, Len(startingCell.Formula) - 1) 
     cellRefChain = cellRefChain & " --> " & thisCellReference 
     level = level + 1 
     ListCellReferenceChain Range(thisCellReference), level 
    Else 
     cellRefChain = cellRefChain & ".Value = " & startingCell.Value 
    End If 
    ListCellReferenceChain = cellRefChain 
End Function 

Function IsReference(cellFormula As String) As String 
    Dim destinationSheet As String 
    Dim pos1 As Integer 
    destinationSheet = "" 
    pos1 = InStr(1, cellFormula, "!", vbTextCompare) 
    If pos1 > 0 Then 
     destinationSheet = Mid(cellFormula, 2, pos1 - 2) 
    End If 
    IsReference = destinationSheet 
End Function 

輸出是

Sheet1!A2.Value = LastName 
Sheet1!A1 --> Sheet2!A1 --> Sheet3!A1 --> Sheet4!A1 --> Sheet5!A1.Value = 123