在VBA中关注VLOOKUP和引用

时间:2015-04-16 15:14:12

标签: excel vba excel-vba vlookup

情况:

我有一个包含许多工作表的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为WerkebereichWerkebereich中引用的单元格对Employees中的工作表Masterdata有自己的依赖关系。所以我要找的是一个像这样的表:

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

我希望我提供足够的信息,了解我的情况,并给我一个提示解决问题的方法:

如何在VBA中关注VLOOKUP之类的引用?

2 个答案:

答案 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文件)很好。