情况:
我有一个包含许多工作表的Excel工作簿。
工作簿中的某些单元格引用MasterData
上的另一个Excel文件(称为vlookup
)。
一个工作表中的一些单元格(称为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
如果您在带有两个名为&#34; PlanningA&#34;的工作表的工作簿上尝试此代码。和&#34; PlanningB&#34;,其中的细胞位于&#34; PlanningA&#34;是:
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)
在&#34; PlanningB&#34;:
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)
您将获得一个名为&#34; Analyze-Blatt&#34;的新工作表。应该是这样的:
|A |B
1|PlanningA |Departments
2| |Stammdaten
3| |Machinery
4|PlanningB |FZE
5| |LKZ-Part
这是第一个级别,因此我知道工作表PlanningA
引用了Departments
中的工作表MasterData
。但正如您所看到的,A1
中的单元格PlanningB
的VLookUp为Werkebereich
。 Werkebereich
中引用的单元格对Employees
中的工作表Masterdata
有自己的依赖关系。所以我要找的是一个像这样的表:
|A |B |C
1|PlanningA |Departments |
2| |Stammdaten |
3| |Machinery |
4|PlanningB |Werkebreich | Employees
5| |FZE |
6| |LKZ-Part |
我希望我提供足够的信息,了解我的情况,并给我一个提示解决问题的方法:
如何在VBA中关注VLOOKUP之类的引用?
答案 0 :(得分:1)
这对你有用吗?
我的测试工作簿有五个工作表。从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
答案 1 :(得分:0)
如果您拥有Office 365或Office Professional Plus 2013,则会有一个名为Spreadsheet Inquire的强大功能,它可以完全满足您的需求,并将在一个漂亮的Web图表中打印出来。更多信息 - 请参阅此处:What you can do with Spreadsheet Inquire
Professional Plus 2013(我们公司拥有许可证)有更多的程序,如Spreadsheet Compare(我们用来区分excel文件)很好。