Znajdź wszystkie użyte referencje we wzorze Excel

Question

Poniżej znajduje się przykład ustawić w programie Excel,

[column1] [column2] 

A1 =C3-C5 

A2 =((C4-C6)/C6) 

A3 =C4*C3 

A4 =C6/C7 

A5 =C6*C4*C3 

muszę wyodrębnić używane odwołań w formułach

Na przykład

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

Answer 1

Ta funkcja zwraca oddzieloną przecinkami listę komórek źródłowych (precedensów):

 
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 

Należy jednak pamiętać, że nie można tego użyć jako arkusza kalkulacyjnego UDF w arkuszu roboczym, ponieważ numer rngRef.Address powoduje niestety odwołanie cykliczne. Możesz jednak użyć go w małej procedurze, aby wypełnić inną kolumnę, np.

 
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 

Answer 2

Wystarczy, aby zapewnić alternatywę ... Zauważ, że ten powróci duplikat wynik jeśli komórki nazywane są częściej niż raz

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 

Wyniki są przechowywane w „Match.Value”

Answer 3

To jest aktualizacja:

Będzie działać dla lokalnych odniesień arkuszy, ale nie dla odniesień poza arkuszem. - brettdj 14 maja '14 godzinie 11:55

stosując metodę Larrys, wystarczy zmienić objRegEx.Pattern do:

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

To będzie:

1. Szukaj dodatkowe linki zewnętrzne : (['].*?['!])?
2. Wyszukaj opcjonalnie Arkusz odniesienia: ([[A-Z0-9_]+[!])?
3. Wykonaj następujące czynności ps w priorytetowej kolejności:
4. Szukaj przedziałów z numerami wierszy (oraz opcjonalnie $): \$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?
5. Szukaj zakresach bez numerów wierszy (oraz opcjonalnie $): \$?[A-Z]+:\$?[A-Z]+
6. szukać odniesień 1-komórkowe (oraz opcjonalnie $): (\$?[A-Z]+\$?(\d)+)

Powstałe w ten sposób:

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 

Spowoduje to, daje wartości wszystkich możliwych odniesień, co myślę z. (Zaktualizowano ten post, ponieważ potrzebowałem rozwiązania problemu).