在Excel公式中查找所有使用的参考

时间:2012-12-12 08:15:13

标签: excel vba excel-vba

以下是Excel中设置的示例

[column1] [column2]

A1  =C3-C5

A2  =((C4-C6)/C6)

A3  =C4*C3

A4  =C6/C7

A5  =C6*C4*C3

我需要在公式中提取使用过的引用

例如,

for "A1", I simply need to get the C3 and C5.
for A2, I need to get the C4 and C6.

3 个答案:

答案 0 :(得分:5)

这是对以下内容的更新:

  

适用于本地工作表参考,但不适用于表外参考。 - brettdj 5月14日和14日11:55

通过使用Larrys方法,只需将objRegEx.Pattern更改为:

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

这将:

  1. 搜索可选的外部链接:(['].*?['!])?
  2. 搜索可选的工作表参考:([[A-Z0-9_]+[!])?
  3. 按优先顺序执行以下步骤:
  4. 搜索行号(和可选$)的范围:\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?
  5. 搜索没有行号的范围(和可选的$):\$?[A-Z]+:\$?[A-Z]+
  6. 搜索单元格引用(和可选$):(\$?[A-Z]+\$?(\d)+)
  7. 导致:

    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
    

    这样做,会给你所有可能参考的价值,我能想到的。 (更新了这篇文章,因为我需要解决问题)。

答案 1 :(得分:3)

此函数返回逗号分隔的源单元格列表(先例):

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

但是,请注意,您不能在工作表中将其用作UDF,因为rngRef.Address不幸导致循环引用。但是,您可以在一个小程序中使用它来填充另一列,例如

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

答案 2 :(得分:1)

只是为您提供另一种选择...请注意,如果多次调用单元格,则会返回重复结果

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

结果存储在“Match.Value”

相关问题