Найти все используемые ссылки в формуле Excel

Question

Ниже приведен пример, установленный в 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.

Answer 1

Это обновление для:

Будет работать для локальных ссылок на листы, но не для ссылок вне листа. - brettdj 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. Поиск ссылок на 1 ячейку (и необязательно $): (\$?[A-Z]+\$?(\d)+)

В результате чего:

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

Делая это, вы получите значения всех возможных ссылок, о которых я мог подумать. (Обновил этот пост, потому что мне нужно было решить проблему).

Answer 2

Эта функция возвращает вам разделенный запятыми список исходных ячеек (прецеденты):

Ссылки на функции (rngSource As Range) как вариант
    Dim rngRef As Range
    Dim strTemp As String
    При ошибке возобновить следующее
    Для каждого rngRef В rngSource.Precedents.Cells
        strTemp = strTemp & ", " & rngRef.Address(False, False)
    следующий
    If Len(strTemp)  0 Тогда strTemp = Mid(strTemp, 3)
    Рекомендации = strTemp
Конечная функция

Тем не менее, обратите внимание, что вы не можете использовать это как UDF на листе, так как rngRef.Address к сожалению вызывает круговую ссылку. Однако вы можете использовать его в небольшой процедуре для заполнения другого столбца, например

Sub ShowPrecedents()
    Dim Rng As Range
    Вставит прецеденты A1:A6 в D1:D6
    Для каждого диапазона входного сигнала ("D1:D6")
        rng.Value = References(rng.Offset(, -3))
    следующий
End Sub

Answer 3

Просто чтобы предоставить вам альтернативу... ЗАМЕТЬТЕ, ЧТО ЭТО вернет повторяющийся результат, если ячейки вызываются более одного раза

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"