Профессиональные приемы работы в Microsoft Excel

Пожалуйста, войдите или зарегистрируйтесь.


Расширенный поиск  

Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Автор Тема: Создать символьную формулу по формуле excel  (Прочитано 1725 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Akor

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

Давно уже пытаюсь упростить жизнь и сделать возможным автоматическое преобразование excel-формулы в "циферно-буквенную".
Есть таблица следующего вида:

Обозначение |      Источник          | Величина
         t1                  задано                    1
         t2                  задано                    2
         t3                   t1+t2                     3
         t4          (t1+t2)/t3+(1/t3)        1,333

В случае наличия формулы в столбце "Величина", в соответствующей строке столбца "Источник" указывается формула в циферно-буквенном виде.
Подскажите, можно ли автоматизировать процесс написания формул в графе источник. Например, создать функцию, обрабатывающую excel формулу и заменяющую все ссылки с величин на обозначения.
« Последнее редактирование: 05.06.2019, 10:42:50 от Akor »
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 596
  • Доброта спасет мир...

Здравствуйте,
c 2013-го Excel'я появились функции ISFORMULA(ЕФОРМУЛА) и FORMULATEXT(Ф.ТЕКСТ).
используйте их

Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Akor

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

В вашем примере результатом является формула вида R1C1, а требуется получить формулу вида "t1+t2...".


P.S. в моем ЦНИИ excel не обновляли с 2010. (В принципе, формулу вида R1C1 я могу получить и через макрофункцию, но методы доступные для "древних" в приоритете)
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 596
  • Доброта спасет мир...

Почему-то машину все хотят поновее и если машине 10 лет, то считается, что уже старая и надо обновить.
но ведь программное обеспечение устаревает быстрее, чем железо...

вам не помешает использовать именованные диапазоны и тогда формула будет выглядеть так как вы захотите.
« Последнее редактирование: 05.06.2019, 23:32:33 от boa »
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Akor

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

Спасибо за пример, но это не решает мою задачу в полном объеме. (Либо я чего-то не понимаю)

Представте себе расчет, состоящий не из 4 строк, а из 4000. Мне придется каждому обозначению присваивать соотвествующее имя в диспетчере имен. Это займет много времени.
Далее, в проекте появились изменения, часть обозначений изменилась. Но имена в диспетчере имен не наследуют изменения обозначений. Как итог - заново перепроверять все соответствия.
Записан

vikttur

  • Глобальный модератор
  • Ветеран
  • *****
  • Уважение: +50/-0
  • Оффлайн Оффлайн
  • Сообщений: 1 016

Таблица соответствий символ/значение у Вас есть.
Макросом препарировать формулу, заменять символы на значения.
Записан

Akor

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

Честно говоря, плохо понимаю о чем речь.
Написал макрос для этой задачи, не очень красивый, но работает. Для тех кто столкнулся с похожей задачей пригодится.

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
« Последнее редактирование: 05.06.2019, 18:31:48 от boa »
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 596
  • Доброта спасет мир...

написал пользовательскую функцию
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
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Akor

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

Андрей, спасибо! Очень красивое решение, и работает лучше, например, когда в формуле сплошь числовые значения вида "1/777". А вот мой макрос такое не любит.
Осталось подумать как прикрутить функции вида cos/ln/log и пр. Как получится - выложу.
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 596
  • Доброта спасет мир...

Очень красивое решение
Спасибо,

Осталось подумать как прикрутить функции вида 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

  • Новичок
  • *
  • Уважение: +0/-0
  • Оффлайн Оффлайн
  • Сообщений: 6

да не вопрос ;)

И этого достаточно? Да как так-то!?  А я ломал голову над тем, как сравнивить строку с массивом введенных алгебраических функций, не очень успешно...

Тестировал на примерах - все работает отлично, но есть одно НО. Range.Value возвращает значения игнорируя их регистр, т.е. если мы имеем величину вида t1 или tк, то получим t1 и tk соответственно
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 596
  • Доброта спасет мир...

Range.Value возвращает значения
И это так. На то оно и Value.
А формат ячейки, это уже другая история и не все так просто будет, но думаю это уже занадто переносить размер шрифта, цвет, курсив и т.п.
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра
 



Темы без ответов

09.08.2019 14:09 Макрос для заполнения таблиц через форму 4998
18.07.2019 16:02 Рассылка почты из Excel при помощи почтовой программы TheBAT! 4413
07.02.2019 01:36 Как удалить дубликаты из выпадающего связанного списка? 5972
03.03.2018 00:00 Подсчет отработанного времени, за исключением заранее определенных перерывов 3117
23.05.2017 11:20 Копирование данных из одной таблицы в умную таблицу по условию 4917
15.03.2017 15:45 автозамена картинок PowerPoint 3838
11.03.2017 13:43 Изменить нумерацию страниц 3764
07.02.2017 18:43 Блокировка ячеек по наступлению даты 2880
28.08.2016 19:29 Одинаковые заголовки после обновления оглавления 3379
07.08.2016 17:33 Определить нумерацию как элемент стиля 3594





Яндекс цитирования msexcel.ru Яндекс.Метрика

Страница сгенерирована за 0.211 секунд. Запросов: 125.