Минимальный рабочий пример с функцией VBA unroll()
,
который принимает ссылку на ячейку с одной функцией
(лайк sum
, count
, min
) и развертывает свой аргумент (список диапазонов) в виде списка отдельных ячеек.
Option Explicit
Function rangeText(s As String) As String
Dim i As Integer, j As Integer
i = Excel.WorksheetFunction.Find("(", s)
j = Excel.WorksheetFunction.Find(")", s)
rangeText = Mid(s, i + 1, j - i - 1)
End Function
Function rangeToList(s As String)
Dim rg As Range: Set rg = Range(s)
Dim i, j As Integer: Dim c As String
For j = 0 To rg.Rows.Count - 1
For i = 0 To rg.Columns.Count - 1
c = c + IIf(c <> "", ",", "") + Chr(64 + rg.Column() + i) + Format(rg.Row() + j)
Next i
Next j
rangeToList = c
End Function
Function unroll(x As Range) As String
Dim s As String: Dim i, j As Integer: Dim list() As String
If Not x.HasFormula Then
s = "Not a formula"
Else
s = rangeText(x.Formula)
list = Split(s, ",")
s = ""
For i = 0 To UBound(list)
s = s + IIf(i > 0, ",", "") + rangeToList(list(i))
Next i
End If
unroll = s
End Function
Примечание: как минимальный пример, он не обрабатывает
двухбуквенные ссылки на столбцы правильно.
* Редактировать *
добавленной Function ColumnNoToName
обрабатывать ссылки на ячейки со столбцами & gt; 26.
Option Explicit
Function rangeText(s As String) As String
Dim i As Integer, j As Integer
i = Excel.WorksheetFunction.Find("(", s)
j = Excel.WorksheetFunction.Find(")", s)
rangeText = Mid(s, i + 1, j - i - 1)
End Function
Function ColumnNoToName(colNo As Integer) As String
Dim lo, hi As Integer: Dim s As String
lo = (colNo - 1) Mod 26
If colNo > 26 Then
hi = (colNo - 1 - lo) \ 26
s = Chr(64 + hi)
End If
s = s + Chr(64 + lo + 1)
ColumnNoToName = s
End Function
Function rangeToList(s As String)
Dim rg As Range: Set rg = Range(s)
Dim i, j As Integer: Dim c As String
For j = 0 To rg.Rows.Count - 1
For i = 0 To rg.Columns.Count - 1
c = c + IIf(c <> "", ",", "") _
+ ColumnNoToName(rg.Column() + i) _
+ Format(rg.Row() + j)
Next i
Next j
rangeToList = c
End Function
Function unroll(x As Range) As String
Dim s As String: Dim i, j As Integer: Dim list() As String
If Not x.HasFormula Then
s = "Not a formula"
Else
s = rangeText(x.Formula)
list = Split(s, ",")
s = ""
For i = 0 To UBound(list)
s = s + IIf(i > 0, ",", "") + rangeToList(list(i))
Next i
End If
unroll = s
End Function
Function cellFormula(x As Range) As String
cellFormula = x.Formula
End Function