Коллеги, добрый день, столкнулся с небольшой трудностью и к сожалению нигде не могу найти ответ. Есть ряд сложных вычислений, который приводит к конечному результату. Например: A1: значение B1: значение C1=A1+B1 D1=A1/B1 E1=C1*D1 - итоговое значение Можно как то вывести весь процесс вычисление в ячейке E1 в виде: =(A1+B1)*A1/B1 - хочу что бы итоговая формула отображалась вот так (формулы естественно сложнее с применением условий).
pikabu, Вы хотите собрать итоговую формулу разбитую на части в разных ячейка? стандартных механизмов нет, нет по тому что табличный процессор как раз и направлен на то чтоб в разных ячейка считались конструкции, но гипотетически, написать макрос. который рекурсивно произведет замены адресов ячеек на формулы размещенные в них. Это не просто , и результат может оказаться нелицеприятным, так как a1=1 a2=2 a3=a1+a2 a4=3 a5=a3*a4 должно выгладить так (a1+a2)*a4, что логично, но так как определять что считаем сперва будет проблематично, то нужно всегда ставить скобки и a1=1 a2=2 a3=a1*a2 a4=3 a5=a3+a4 станет (a1*a2)+a4 хотя скобки не нужны, а при сложных вычислениях таких скобок может оказаться много.
написал: Можно как то вывести весь процесс вычисление в ячейке E1 в виде
при помощи макроса, если только. При этом не факт, что макрос будет простым, т.к. придется определять что есть ссылка на ячейку, а что нет. При этом надо будет так же учесть и то, что формулы могут быть более сложными: B1 = "=ВПР(F1; A1:C10;2;0)" A2 = "=МИН(A1;B1:B10)" C1 = "=(B1+A1+А2+МАКС(F1:G10;-1))*16%". Как это должно выглядеть в итоге?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
написал: pikabu, Вы хотите собрать итоговую формулу разбитую на части в разных ячейка? стандартных механизмов нет, нет по тому что табличный процессор как раз и направлен на то чтоб в разных ячейка считались конструкции, но гипотетически, написать макрос. который рекурсивно произведет замены адресов ячеек на формулы размещенные в них. Это не просто , и результат может оказаться нелицеприятным, так как a1=1 a2=2 a3=a1+a2 a4=3 a5=a3*a4 должно выгладить так (a1+a2)*a4, что логично, но так как определять что считаем сперва будет проблематично, то нужно всегда ставить скобки и a1=1 a2=2 a3=a1*a2 a4=3 a5=a3+a4 станет (a1*a2)+a4 хотя скобки не нужны, а при сложных вычислениях таких скобок может оказаться много.
Спасибо большое, значит не просто так я не смог найти ответ на просторах интернета) будем в ручную значит собирать)
Тоже инетересовался ранее подобным вопросом, попробовал изобразить. Функция (GetFullFrml) не совершенна, может увидеть ссылки только с текущего листа, за это отвечает регулярное выражение "[A-Z]{1,3}[0-9]{1,7}", которое можно улучшить. Также можно улучшить функцию NormalizeFrml, чтобы ставила скобки только там где нужно и т.д. 1 аргумент ячейка с формуловй, 2й - опциональный (0-2). В зависимости от аргумента результат будет
=(A1+B1)*(A1/B1)
=(2+5)*(2/5)
(2+5)*(2/5) = 2,8
Код
Public ArgsDict As New Collection, FndArgsDict As New Collection
Public Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Function GetFullFrml(cell, Optional opt As Integer = 0)
Dim frml, frml2, frml3, a, b, key, item
frml = cell.Formula
GetArgs frml 'получение аргументов (имен ячеек) и формул в коллекции ArgsDict, FndArgsDict
frml2 = frml
For a = 1 To ArgsDict.Count
key = ColKey(a, ArgsDict)
item = ArgsDict(a)
frml2 = Replace(frml2, key, item)
Next
frml3 = frml2
For a = 1 To FndArgsDict.Count
key = ColKey(a, FndArgsDict)
item = FndArgsDict(a)
frml3 = Replace(frml3, key, item)
Next
Select Case opt
Case 0: GetFullFrml = frml2
Case 1: GetFullFrml = frml3
Case 2: GetFullFrml = Mid(frml3 & " = " & cell.Value, 2)
End Select
End Function
Sub GetArgs(ByVal frml)
Dim Arg, frml2 As String
Static RE As New RegExp, varInit As Boolean
With RE
'регулярное выражение для определения имен(ссылок) ячеек в формуле
If Not varInit Then .Global = True: .Pattern = "[A-Z]{1,3}[0-9]{1,7}": varInit = True
For Each Arg In .Execute(frml)
frml2 = NormalizeFrml(Range(Arg).Formula)
If .Test(frml2) Then
'ArgsDict(Arg & "") = frml2
CollAdd ArgsDict, Arg, frml2
GetArgs frml2
Else
'FndArgsDict(Arg & "") = frml2
CollAdd FndArgsDict, Arg, frml2
End If
Next
End With
End Sub
Function NormalizeFrml(frml)
If InStr(frml, "=") Then
NormalizeFrml = "(" & Replace(frml, "=", "") & ")"
Else
NormalizeFrml = frml
End If
End Function
Sub CollAdd(ByRef c As Collection, k As Variant, V As Variant) 'https://stackoverflow.com/questions/32180457/change-value-of-an-item-in-a-collection-in-a-dictionary
On Error Resume Next
With c
.Remove k
On Error GoTo 0
.Add V, k
End With
End Sub
Function ColKey(ByVal Index As Long, Col As Collection) As String 'https://www.cyberforum.ru/visual-basic/thread1096760.html
Dim lpSTR As Long, Ptr As Long, key As String
If Col Is Nothing Then Exit Function
Select Case Index
Case Is < 1, Is > Col.Count: Exit Function
Case Else
Ptr = ObjPtr(Col)
Do While Index
GetMem4 ByVal Ptr + 24, Ptr
Index = Index - 1
Loop
End Select
lpSTR = StrPtr(key)
GetMem4 ByVal Ptr + 16, ByVal VarPtr(key)
ColKey = key
GetMem4 lpSTR, ByVal VarPtr(key)
End Function
написал: Также можно улучшить функцию NormalizeFrml, чтобы ставила скобки только там где нужно
Код
Function NormalizeFrml(frml)
Static RE As New RegExp
With RE
.Pattern = "^="
frml = .Replace(frml, "")
.Global = True
.Pattern = "[+,-]"
If .Test(frml) Then
.Pattern = "\(*[+,-]*\)" 'добавляем скобки если в выражении есть +/-, но нет скобок
If Not .Test(frml) Then frml = "(" & frml & ")"
End If
NormalizeFrml = frml
End With
End Function