Извлечь адреса ячеек из формулы

Question

Ищу способ извлечения адресов / диапазонов из формул. Я создал пример формулы ниже.

=SUMIFS(Worksheet_Name!$C$3:$C$20, Worksheet_Name!$A$3:$A$20, "Blue", Worksheet_Name!$B$3:$B$20, "Green")

Я пытаюсь получить какую-то процедуру VBA, которую я могу разобрать по формулам.

Я хотел бы получить следующие диапазоны:

Worksheet_Name!$C$3:$C$20

Worksheet_Name!$A$3:$A$20

Worksheet_Name!$B$3:$B$20

Так что я могу получить к ним доступ отдельно.

Answer 1

Попробуйте это

Sub Test()
    Dim e, s As String
    s = MyArguments(Range("A1"))
    For Each e In Split(s, ",")
        If InStr(e, "!") Then Debug.Print Trim(e)
    Next e
End Sub

Function MyArguments(rng As Range) As String
    MyArguments = Split(Split(rng.Formula, "(")(1), ")")(0)
End Function

Answer 2

Как насчет следующего, это примет ячейку в качестве входных данных, затем он вычеркнет все, что находится за пределами скобок, и разделит оставшуюся часть формулы запятыми в массив, а затем он будет отображаться в Msgbox, но вы можете адаптировать это к вашим потребностям:

Sub Get_Ranges_In_Formula()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare the worksheet you are working with
Dim rngs As String
Dim arrayofRngs

cellvalue = ws.Range("A1").Formula
'get the formula from the cell

openingParen = InStr(cellvalue, "(")
closingParen = InStrRev(cellvalue, ")")
rngs = Mid(cellvalue, openingParen + 1, closingParen - openingParen - 1)
'strip anything outside the brackets

arrayofRngs = Split(rngs, ",")
'split by comma into array

For i = LBound(arrayofRngs) To UBound(arrayofRngs)
    If InStr(arrayofRngs(i), "!") > 0 Then MsgBox arrayofRngs(i)
Next
End Sub

Решение, использующее RegEx для извлечения ссылок на ячейки из формул:

Sub Get_Ranges_In_Formula()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim xRetList As Object
    Dim xRegEx As Object
    Dim I As Long
    Dim xRet As String
    Dim Rg As Range

    Set Rg = ws.Range("A1")
    Application.Volatile
    Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    With xRegEx
        .Pattern = "('?[a-zA-Z0-9\s\[\]\.]{1,99})?'?!?\$?[A-Z]{1,3}\$?[0-9]{1,7}(:\$?[A-Z]{1,3}\$?[0-9]{1,7})?"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    Set xRetList = xRegEx.Execute(Rg.Formula)
    If xRetList.Count > 0 Then
        For I = 0 To xRetList.Count - 1
            MsgBox xRetList.Item(I)
        Next
    End If
End Sub