Find all used references in Excel formula

前端 未结 3 759
春和景丽
春和景丽 2020-12-10 17:07

Below is the example set in Excel,

[column1] [column2]

A1  =C3-C5

A2  =((C4-C6)/C6)

A3  =C4*C3

A4  =C6/C7

A5  =C6*C4*C3

I need to extr

相关标签:
3条回答
  • 2020-12-10 17:40

    This function returns you a comma separated list of source cells (precedents):

    Function References(rngSource As Range) As Variant
        Dim rngRef As Range
        Dim strTemp As String
        On Error Resume Next
        For Each rngRef In rngSource.Precedents.Cells
            strTemp = strTemp & ", " & rngRef.Address(False, False)
        Next
        If Len(strTemp)  0 Then strTemp = Mid(strTemp, 3)
        References = strTemp
    End Function
    

    However, please note that you cannot use this as a UDF in the worksheet, as rngRef.Address unfortunately causes a circular reference. However, you can use it in a small procedure to populate another column, e.g.

    Sub ShowPrecedents()
        Dim rng As Range
        'Will paste precedents of A1:A6 into D1:D6
        For Each rng In Range("D1:D6")
            rng.Value = References(rng.Offset(, -3))
        Next
    End Sub
    
    0 讨论(0)
  • 2020-12-10 17:42

    This is an update to:

    Will work for local sheet references, but not for references off-sheet. – brettdj May 14 '14 at 11:55

    By Using Larrys method, just change the objRegEx.Pattern to:

    (['].*?['!])?([[A-Z0-9_]+[!])?(\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?|\$?[A-Z]+:\$?[A-Z]+|(\$?[A-Z]+\$?(\d)+))
    

    This will:

    1. Search for optional External links: (['].*?['!])?
    2. Search for optional Sheet-reference: ([[A-Z0-9_]+[!])?
    3. Do the following steps in prioritized order:
    4. Search for ranges with row numbers (And optional $): \$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?
    5. Search for ranges without row numbers (And optional $): \$?[A-Z]+:\$?[A-Z]+
    6. Search for 1-cell references (And optional $): (\$?[A-Z]+\$?(\d)+)

    Resulting in this:

    Sub testing()
    Dim result As Object
    Dim r As Range
    Dim testExpression As String
    Dim objRegEx As Object
    
    Set r = Cells(1, 2)  ' INPUT THE CELL HERE , e.g.    RANGE("A1")
    Set objRegEx = CreateObject("VBScript.RegExp")
    objRegEx.IgnoreCase = True
    objRegEx.Global = True
    objRegEx.Pattern = """.*?"""  ' remove expressions
    testExpression = CStr(r.Formula)
    testExpression = objRegEx.Replace(testExpression, "")
    objRegEx.Pattern = "(([A-Z])+(\d)+)"  'grab the address
    
    objRegEx.Pattern = "(['].*?['!])?([[A-Z0-9_]+[!])?(\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?|\$?[A-Z]+:\$?[A-Z]+|(\$?[A-Z]+\$?(\d)+))"
    If objRegEx.test(testExpression) Then
        Set result = objRegEx.Execute(testExpression)
        If result.Count > 0 Then
            For Each Match In result
                Debug.Print Match.Value
            Next Match
        End If
    End If
    End Sub
    

    Doing this, will give you the values of all possible references, I could think of. (Updated this post, because I needed the problem solved).

    0 讨论(0)
  • 2020-12-10 18:01

    Just to provide you an alternative... NOTE THAT THIS will return duplicate result if the cells are called more than once

    Sub testing()
    Dim result As Object
    Dim r As Range
    Dim testExpression As String
    Dim objRegEx As Object
    
    Set r = Cells(1, 2)  ' INPUT THE CELL HERE , e.g.    cells("A1")
    Set objRegEx = CreateObject("VBScript.RegExp")
    objRegEx.IgnoreCase = True
    objRegEx.Global = True
    objRegEx.Pattern = """.*"""  ' remove expressions
    testExpression = CStr(r.Formula)
    testExpression = objRegEx.Replace(testExpression, "")
    objRegEx.Pattern = "(([A-Z])+(\d)+)"  'grab the address
    
    If objRegEx.test(testExpression) Then
        Set result = objRegEx.Execute(testExpression)
        If result.Count > 0 Then
            For Each Match In result
                Debug.Print Match.Value
            Next Match
        End If
    End If
    End Sub
    

    Results are stored in "Match.Value"

    0 讨论(0)
提交回复
热议问题