Давно уже пытаюсь упростить жизнь и сделать возможным автоматическое преобразование excel-формулы в "циферно-буквенную".
Есть таблица следующего вида:
Обозначение | Источник | Величина
t1 задано 1
t2 задано 2
t3 t1+t2 3
t4 (t1+t2)/t3+(1/t3) 1,333
В случае наличия формулы в столбце "Величина", в соответствующей строке столбца "Источник" указывается формула в циферно-буквенном виде.
Подскажите, можно ли автоматизировать процесс написания формул в графе источник. Например, создать функцию, обрабатывающую excel формулу и заменяющую все ссылки с величин на обозначения.
Здравствуйте,
c 2013-го Excel'я появились функции ISFORMULA(ЕФОРМУЛА) (https://support.office.com/en-us/article/isformula-function-e4d1355f-7121-4ef2-801e-3839bfd6b1e5) и FORMULATEXT(Ф.ТЕКСТ) (https://support.office.com/en-us/article/formulatext-function-0a786771-54fd-4ae2-96ee-09cda35439c8).
используйте их
В вашем примере результатом является формула вида R1C1, а требуется получить формулу вида "t1+t2...".
(http://akor2.png)
P.S. в моем ЦНИИ excel не обновляли с 2010. (В принципе, формулу вида R1C1 я могу получить и через макрофункцию, но методы доступные для "древних" в приоритете)
[suspicious]Почему-то машину все хотят поновее и если машине 10 лет, то считается, что уже старая и надо обновить.
но ведь программное обеспечение устаревает быстрее, чем железо...[/suspicious]
вам не помешает использовать именованные диапазоны и тогда формула будет выглядеть так как вы захотите.
Спасибо за пример, но это не решает мою задачу в полном объеме. (Либо я чего-то не понимаю)
Представте себе расчет, состоящий не из 4 строк, а из 4000. Мне придется каждому обозначению присваивать соотвествующее имя в диспетчере имен. Это займет много времени.
Далее, в проекте появились изменения, часть обозначений изменилась. Но имена в диспетчере имен не наследуют изменения обозначений. Как итог - заново перепроверять все соответствия.
Таблица соответствий символ/значение у Вас есть.
Макросом препарировать формулу, заменять символы на значения.
Честно говоря, плохо понимаю о чем речь.
Написал макрос для этой задачи, не очень красивый, но работает. Для тех кто столкнулся с похожей задачей пригодится.
Sub test()
stopsymbols = Array("+", "-", "/", "*", "^", "(", ")") 'стоп символы
stopsymbols2 = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0") 'если в формуле есть цифры
Dim s, s1, s2, s3 As String
Dim element, element2 As Variant
s = ActiveCell.FormulaLocal 'что там у нас в активной ячейке?
s = Replace(s, "=", "") 'убрать =
s = Replace(s, "D", "B") 'меняем с D на B
s1 = Len(s) 'найти длину строки
i = 0 'номер символа
s3 = Empty
While s1 >= i 'пока строка не закончилась
i = i + 1 'счетчик строки
k = 0
si = Mid(s, i, 1) 'перебираем символы по одному
For Each element In stopsymbols
stopsymbol = element
If si = element Then 'попали на стоп-слово?
If s2 <> Empty Then
For Each element2 In stopsymbols2
stopsymbol2 = element2
If s2 = element2 Then
s3 = s3 & s2 & si
s2 = Empty
ElseIf s2 <> Empty Then
s3 = s3 & Range(s2).Value & si
s2 = Empty
End If
Next
Else
s3 = s3 & si
End If
Else 'нет
k = k + 1
End If
Next
If k = UBound(stopsymbols) + 1 Then
k = 0
s2 = s2 & si
End If
Wend
ActiveCell.Offset(0, 1).Range("A1").Select
If ActiveCell.Value = "" Then
ActiveCell.Value = s3
Else
MsgBox ("Ячейка для вставки занята")
End If
End Sub
написал пользовательскую функцию
Function FormulaSubstitution(a As Range, OffsetColumn&)
'' Author: boa
'' Written: 05.06.2019
'' Edited:
' Description: a - ячейка из которой надо извлечь формулу _
OffsetColumn - смещение по колонкам (+/-) для получения подстановочного имени
Dim sFormula$, i, sh As Worksheet, sSymbols(), MyArr
Set sh = Application.Caller.Parent
sSymbols = Array("=", "+", "-", "/", "*", "^", "(", ")", "{", "}", ";", " ")
If a.Formula = CStr(a.Value) Then FormulaSubstitution = "Задано": Exit Function
sFormula = a.Formula
For Each i In sSymbols
sFormula = Replace(sFormula, i, " ")
Next
MyArr = Split(Trim(sFormula), " ")
sFormula = a.Formula
For Each i In MyArr
If Not IsNumeric(i) Then _
sFormula = Replace(sFormula, i, sh.Range(i).Offset(, OffsetColumn).Value)
Next
FormulaSubstitution = Mid(sFormula, 2)
' или так
' FormulaSubstitution = Replace(sFormula, "=", "")
End Function
Андрей, спасибо! Очень красивое решение, и работает лучше, например, когда в формуле сплошь числовые значения вида "1/777". А вот мой макрос такое не любит.
Осталось подумать как прикрутить функции вида cos/ln/log и пр. Как получится - выложу.
Цитата: Akor от 05.06.2019, 19:33Очень красивое решение
Спасибо,
Цитата: Akor от 05.06.2019, 19:33
Осталось подумать как прикрутить функции вида cos/ln/log и пр.
да не вопрос ;)
Function FormulaSubstitution(a As Range, OffsetColumn&)
'' Author: boa
'' Written: 05.06.2019
'' Edited:
' Description: a - ячейка из которой надо извлечь формулу _
OffsetColumn - смещение по колонкам (+/-) для получения подстановочного имени
Dim sFormula$, i, sh As Worksheet, sSymbols(), MyArr
Application.Volatile True
Set sh = Application.Caller.Parent
sSymbols = Array("=", "+", "-", "/", "*", "^", "(", ")", "{", "}", ";", ".", ",", " ")
If a.Formula = CStr(a.Value) Then FormulaSubstitution = "Задано": Exit Function
sFormula = a.Formula
For Each i In sSymbols
sFormula = Replace(sFormula, i, " ")
Next
MyArr = Split(Trim(sFormula), " ")
sFormula = a.Formula
On Error Resume Next
For Each i In MyArr
If Not IsNumeric(i) Then _
sFormula = Replace(sFormula, i, sh.Range(i).Offset(, OffsetColumn).Value)
Next
FormulaSubstitution = Mid(sFormula, 2)
' или так
' FormulaSubstitution = Replace(sFormula, "=", "")
End Function
Цитата: Akor от 05.06.2019, 19:33
да не вопрос ;)
И этого достаточно? Да как так-то!? А я ломал голову над тем, как сравнивить строку с массивом введенных алгебраических функций, не очень успешно...
Тестировал на примерах - все работает отлично, но есть одно НО. Range.Value возвращает значения игнорируя их регистр, т.е. если мы имеем величину вида t
1 или t
к, то получим t1 и tk соответственно
Цитата: Akor от 06.06.2019, 11:12
Range.Value возвращает значения
И это так. На то оно и Value.
А формат ячейки, это уже другая история и не все так просто будет, но думаю это уже занадто переносить размер шрифта, цвет, курсив и т.п.