Excel. Формулки. Скрипт v.5

Excel. Формулки. Скрипт v.5 · 23.03.2008, 12:14

Доброго времени суток
Предлагаю скрипт функции. Функция записывает формулу указанной ячейки в числах с подстановкой (в другой ячейке разумеется).
Для чего? Иногда надо чтобы "ход расчёта" был виден. С этим в экселе при распечатке плохо - не проверить как и откуда получилось то или иное значение.

Код:

[Выделить все]

Public Function zFrml(i As Range) As String
Application.Volatile True
Dim str As String
str = i.Formula
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = ",\d+\)|[ROUNDPWN]{4,10}\("
End With
str = RegEx.Replace(str, "")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "([A-Z]{1,2}\d{1,5})"
End With
str = RegEx.Replace(str, """&$1&""")
Set RegEx = Nothing
str = Replace(str, "*", Chr(183))
str = Replace(str, "=", "=""")
If (InStr(str, "&") = 2) Then str = Replace(str, "=&", "=")
If (InStr(str, """&") = 2) Then str = Replace(str, "=""&", "=")
If (InStrRev(str, "&") < Len(str)) Then str = str + "="""
If (InStrRev(str, "&") = Len(str)) Then str = str + """="""
str = Evaluate(str)
str = Replace(str, ".", ",")
zFrml = str
End Function

Public Function zFrml3(i As Range, units As String) As String
Application.Volatile True
Dim str As String
str = i.Formula
Dim va As String
va = i.Value
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = ",\d+\)|[ROUNDPWN]{4,10}\("
End With
str = RegEx.Replace(str, "")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "(([A-Z]{1,2}\d{1,5})|(zZif\([A-Z]{1,2}\d{1,5}\)))"
End With
str = RegEx.Replace(str, """&$1&""")
Set RegEx = Nothing
str = Replace(str, "*", Chr(183))
str = Replace(str, "=", "=""")
If (InStr(str, "&") = 2) Then str = Replace(str, "=&", "=")
If (InStr(str, """&") = 2) Then str = Replace(str, "=""&", "=")
If (InStrRev(str, "&") < Len(str)) Then str = str + " = """
If (InStrRev(str, "&") = Len(str)) Then str = str + """ = """
str = str + "&" + i.Address
If (Len(units) > 0) Then str = str + "&"" [" + units + "]"""
str = Evaluate(str)
str = Replace(str, ".", ",")
zFrml3 = str
End Function

Public Function zZif(i As Range)
Application.Volatile True
Dim str As String
str = i.Formula
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "=zFrml3\(([A-Z]{1,2}\d{1,5})+,[\d\D""]{2,5}"
        
End With
str = RegEx.Replace(str, "$1")
Set RegEx = Nothing
str = Range(str).Value
zZif = str
End Function

На картинке видно название функции и её применение.
Надеюсь пригодиться ещё кому-нить.

Ещё кое-что полезное - xla-надстройка. Для чего? Для форматирования текста в ячейках. В паре с вышеперечисленными функциями дает неплохой вариант оформления.
В общем-то на миниатюре видно как оно всё выглядит, тратить времени на это форматирование я стал меньше, факт

SLADE · 23.03.2008, 22:59 **Супер**

Отличный скрипт, конечно пригодится.
Я раньше это все делал вручную

Не во всех столбцах у меня работает (А,С,I,N,O,S,T, AA и далее = не работает ), вместо чисел пишет ссылку, на ячейку

YRat · 23.03.2008, 23:57

Ага, доделаю, выложу

Кстати, любую степень типа корня, записывать не как формула корна, а как ^0.5

YRat · 25.03.2008, 19:55

Поправил, вроде как работает)

п.с. поправил в первом посте!

SLADE · 25.03.2008, 20:30

ООО сейчас отлично

YRat · 25.03.2008, 20:53

Ну гут, давно мечтал соорудить

SLADE · 25.03.2008, 21:58

еще бы хотелось конечно что бы при ссылке на ячейку где присудствует в формуле функции, типа МАкс, мин впр, гпр и подобные ищущие значения писала найденое значение .
=A4-A3*A2*SIN(A1)+ВПР(B6;A1:E4;2;0)
4-34•2•SIN(1)+VLOOKUP(34,1:4,2=
В противном итоге придется поиск значений выполнять в соседних ячейках.

YRat · 25.03.2008, 22:05

Если Вы мне дадите эксель файлик со всеми (или наиболее частыми) функциями такими я подумаю над ним, ато у меня на русском нет ёкселя =)
ОТправить можно на почту, только с пометкой ([email protected])

SLADE · 25.03.2008, 22:14

Пока конкретного нету примера, как только так сразу. ПОКа ВСЕ СУпер

раньше приходилось делать так в ячейке
="в этой формуле h* = [h·(Pγ+3·Pq)] / [3·(Pγ+2·Pq)] = ["&C5&"·("&I73&"+3·"&I76&")] / [3·("&I73&"+2·"&I76&")] = "&J108&" м"
для получения результата:
в этой формуле h* = [h·(Pγ+3·Pq)] / [3·(Pγ+2·Pq)] = [2.4·(13.48+3·3.996)] / [3·(13.48+2·3.996)] = 0.949 м

теперь достаточно написать
"в этой формуле h* = [h·(Pγ+3·Pq)] / [3·(Pγ+2·Pq)] = "&zFrml(J108)&" "&J108&" м"
результат:
в этой формуле h* = [h·(Pγ+3·Pq)] / [3·(Pγ+2·Pq)] = (2,4•(13,48+3•3,996)) / (3•(13,48+2•3,996))= 0.949 м

как ументшить точку "•" - сделать "·"?

YRat · 25.03.2008, 22:18

А, Вы имеете ввиду чтобы при обращении из другой ячейки тут было число, не, я так не могу, он возьмёт именно то, что показывает в листе
Но я подумаю.. придётся, наверное, еще одну функцию вводить =)

YRat · 25.03.2008, 22:42

Чтобы точка было смените строку
str = Replace(str, "*", Chr(149))
на
str = Replace(str, "*", Chr(183))

YRat · 25.03.2008, 23:44

Возможно дурацкий вопрос, но в примере в ячейке J108 все равно остается результат.. или предполагается выносить эти ячейки куда-нить за пределы печатного листа?

Там снова изменился скрипт - кое-что забыл..

SLADE · 26.03.2008, 00:47

то что я писал в посте 9 , это не вопрос , а просто на сколько сокращается оформление расчетов.
лично мне кажется, в плане офотмления, ячейка со всеми вычислениями "J108", её можно по желанию потом скрыть, защитить.
Я думаю, впринципе, если &zFrml(J108)&" "&J108, [2.4·(13.48+3·3.996)] / [3·(13.48+2·3.996)] = 0.949, лучше объединить в вместе , чтобы она писала сразу после выражения " = результат"
Это конечно будет полезно кто оформляет формулу с привязкой текста в ячейке "по левому краю", т.е. в длинну строку нечто не ограничивает

YRat · 26.03.2008, 14:12

Итак, скрипт изменил, добавил еще 2 функции

zFrml3(ячейка;"единицы измерения или пусто")
Пишет формулу и результат с единицей измерения

Пример:
формула
=zFrml3(I38;"kN")

В ячейке I38
=ОКРУГЛ(B37*(B38*B39*B49+B50*B51*B52*B53);2)

результат
= 1·(1·1431,57748275·0,785+3,14·0,6·48·6) = 1666,38 [kN]

Чтобы из такой ячейки куда-нибудь вставить ТОЛЬКО значение, нужно использовать следующую функцию

zZif(ячейка с функцией zFrml3)
Функция просто вставляет результат от ячейки с предыдущей функцией

ВладимирН · 26.03.2008, 15:19

простите, пожалуйста, а как это все установить?????

YRat · 26.03.2008, 15:50

ВладимирН

1. Открываете новый или старый excel документ
2. F11
3. Слева выделите VBAProjekt(Книга 1)
4. Меню вверху: Вставить - Модуль
5. Скопировать туда текст скриптов и сохранить
6. Безопасность в макросах должна либо разрешать макросы либо спрашивать каждый раз "включить макросы али нет"
Ну и использовать функции как простые в ячейках

Да..функции будут работать только в тех документах, где будет этот модуль.
Как сделать чтобы везде пока не думал, наверняка можно и все давно придумано - надо искать

ВладимирН · 26.03.2008, 16:00

бальшоеспасибки

SLADE · 26.03.2008, 23:24

Последнее изменение просто прелесть.
Лучшего и представить не мог.

YRat · 26.03.2008, 23:31

Vik-ing · 28.03.2008, 13:44

Хорошая штука, спасибо.
А чтобы функции были видны во всех книгах, надо сделать надстройку: пустую книгу, содержащую модуль с функциями сохранить как *.xla (надстройка). После этого загрузить сохраненный файл:
Сервис->Надстройки. Удачи!

SLADE · 28.03.2008, 20:20

YRat привет есть пару идей по модернизации, например , было бы неплохо сочетание ^2 заменять символом ² (00B2) ; ^3 - ³ (00B2)
zFrml - что бы не писала "="
При защите листа макрос перестает работать, это навсегда?
Спасибо

YRat · 28.03.2008, 21:50

про замену. Сложно, почему, потому как у тебя может стоять ^20 а поставит только квадрат, хотя степени 20 и 30 и более редкость, сделать попробую
Про равно - уберу
про защиту листа... проверю, что смогу

YRat · 28.03.2008, 22:27

Про защиту листа и всей книги - у меня все продолжает работать.. я сказал какие ячейки можно изменять и все.. все работает

Клякса · 28.03.2008, 23:03

Есть личная книга макросов в ехеле. Макрос, функция или любая саба из этой книги может быть доступна в ЛЮБОЙ новой или старой книге. Примерное расположение:
C:\Documents and Settings\Алексей\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLS

YRat · 28.03.2008, 23:09

Клякса, да, это так, но не в каждой книге мне нужны эти функции, проще сделать себе xlt-шаблон для расчетов

YRat · 29.03.2008, 17:35

SLADE
Таг, про замену - невозможно, ибо эти символы находятся вне анси кодировки, НО
Сделай себе автозамену все решается)

Replace: With:
(micro) µ
(delta) ∆
(deg) °
(degree) °
(+/-) ±
(^2) ²
(^3) ³
(1/4) ¼
(1/2) ½
(3/4) ¾
(dot) ·
(part) ∂
(partial) ∂
(inf) ∞
(infinity) ∞

Где делать? Англ.путь таков Tools > Options > Spelling tab > Autocorrect Options button > Autocorrect tab
Так что в русском нечто типа сервис,опции, проверка орфографии, автозамена

Воот, сам проверил, у меня работает НО при введении формулы, т.е. старые формулы само не заменит!

Знак равно убрал, смотри первый пост, заодно там xla-надстройка для форматирования - оформления формул

YRat · 03.04.2008, 11:18

По поводу автозамены ^2 на квадратик..
Я сделал автозамену не (^2), а ^2 на ² - думал я самый умный, оказалось нет, надоделать именно (^2), ибо (прикиньте, ИБО ©КВН) если писать ^2 просто в формуле, то эта зараза тоже заменяет на ² и ёксель не считает за формулу это и ругается, вот

SLADE · 24.04.2008, 17:02

YRat для логических операторов подладить можно?
(иногда форлула с логич. операторами записывается, и тогда функцыя не видит формулу)

YRat · 24.04.2008, 17:05

SLADE, листик с примерами прикрепляй, посмотрим
С нужными примерами имею ввиду

SLADE · 25.04.2008, 10:02

проложил

YRat · 25.04.2008, 12:57

SLADE, значит так:
Вариант 1
Представь себе, что там 3 раза вложен "если"..
[IMG]http://i024.***********/0804/9d/0ad781b414b2.png[/IMG]
сложновато, но подумаю

Вариант 2
В функции zzif по определению аргументом может быть ячейка, содержащая ТОЛЬКО фунцию zfrml3
Тоже подумаю

Есть еще один вариант.. правда посложнее..
выражение брать по варианту 2, а значение по 1

SLADE · 25.04.2008, 13:31

хитец однако,
Просто ели применять вариант 2, то можно не пользоваться дополнительными вычислениями

YRat · 25.04.2008, 13:37

SLADE,
кстати, не мог бы ты прикрепить сюда один из своих листов, или мне на мыло, хоть посмотреть как это там у тебя выглядит в полном варианте

SLADE · 28.04.2008, 17:59

YRat а то что я выложил, не подошло , или просто пример применения скрипта ? (я непонял что выложить?)

YRat · 28.04.2008, 18:59

SLADE, ты там чегой-то оформляешь же? Выложи какой-нить оформленный пример, чтобы подивиться.

SLADE · 29.04.2008, 14:57

хорошо, выложу

SLADE · 17.05.2008, 12:01

YRat привет, очистить формулу от $ можно?
=$M28/1000*$O28*0.001*F4*0.3
= $180/1000·$1,5·6·0,001·80·0,3 = 0,03888 [тс]
при жесткой привязке пишет
= $M$28/1000·$1,5·0,001·80·0,3 = 0,00648 [тс/м]

YRat · 19.05.2008, 01:30

Угу, можно, там надо просто отфильтровать этот знак перед обработкой

SLADE · 05.08.2010, 02:05

YRat доброго времени суток.
Подскажи пож.
При переходе с листа на лист значения в формулы в ячейках с командой zFrml3 или zFrml , имеют вид, например
= (+(/3)·(2-(/)))/1000 = [м]
а после ввода ссылки обнавляются
получаю требуемы вид
= (150+(250/3)·(2-(27,398/65,747)))/1000 = 0,282 [м]

Можно что-нибудь подшаманить, чтобы не приходилось каждый раз жать ввод???

hwd · 05.08.2010, 14:24

Здесь можно посмотреть кучу кода по теме.

YRat · 06.08.2010, 14:37

Цитата:

Сообщение от SLADE

YRat доброго времени суток.
Подскажи пож.
При переходе с листа на лист значения в формулы в ячейках с командой zFrml3 или zFrml , имеют вид, например
= (+(/3)·(2-(/)))/1000 = [м]
а после ввода ссылки обнавляются
получаю требуемы вид
= (150+(250/3)·(2-(27,398/65,747)))/1000 = 0,282 [м]

Можно что-нибудь подшаманить, чтобы не приходилось каждый раз жать ввод???

Сейчас обновлю первый пост)

>hwd: спасибо

SLADE · 07.08.2010, 11:49

Мне чесно нравиться смесь нового и старого (из-за $)

Цитата:

Function zFrml(i As Range) As String
Application.Volatile True 'Application.Volatile
Dim str As String
str = i.Formula
Set RegEx = CreateObject("vbscript.regexp")
str = Replace(str, "$", "")
With RegEx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = ",\d+\)|[ROUNDPWN]{4,10}$"
End With
str = RegEx.Replace(str, "")
With RegEx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = "([A-Z]{1,2}\d{1,5})"
End With
str = RegEx.Replace(str, """&$1&""")
Set RegEx = Nothing
str = Replace(str, "*", Chr(183))
str = Replace(str, "=", "=""")
If (InStr(str, "&") = 2) Then str = Replace(str, "=&", "=")
If (InStr(str, """&") = 2) Then str = Replace(str, "=""&", "=")
If (InStrRev(str, "&") < Len(str)) Then str = str + "="""
If (InStrRev(str, "&") = Len(str)) Then str = str + """="""
str = Evaluate(str)
str = Replace(str, ".", ",")
zFrml = str
End Function

Function zFrml3(i As Range, units As String) As String
Application.Volatile True 'Application.Volatile
Dim str As String
str = i.Formula
str = Replace(str, "$", "")
Dim va As String
va = i.Value
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = ",\d+$|[ROUNDPWN]{4,10}$"
End With
str = RegEx.Replace(str, "")
With RegEx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = "(([A-Z]{1,2}\d{1,5})|(zZif\([A-Z]{1,2}\d{1,5}$))"
End With
str = RegEx.Replace(str, """&$1&""")
Set RegEx = Nothing
str = Replace(str, "*", Chr(183))
str = Replace(str, "=", "=""= ")
If (InStr(str, "&") = 2) Then str = Replace(str, "=&", "=")
If (InStr(str, """&") = 2) Then str = Replace(str, "=""&", "=")
If (InStrRev(str, "&") < Len(str)) Then str = str + " = """
If (InStrRev(str, "&") = Len(str)) Then str = str + """ = """
str = str + "&" + i.Address
If (Len(units) > 0) Then str = str + "&"" [" + units + "]"""
str = Evaluate(str)
str = Replace(str, ".", ",")
zFrml3 = str
End Function

Function zZif(i As Range)
Application.Volatile True 'Application.Volatile
Dim str As String
str = i.Formula
str = Replace(str, "$", "")
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = "=zFrml3\(([A-Z]{1,2}\d{1,5})+,[\d\D""]{2,5}"
End With
str = RegEx.Replace(str, "$1")
Set RegEx = Nothing
str = Range(str).Value
zZif = str
End Function
Option Base 1
Option Explicit
Public xj As Integer, yi As Integer

SLADE · 27.10.2010, 01:42

YRat привет.
подскажи пожалуйста, сложно ли подправить код, возникла неувязочка при применения округления значения:
=(N40*2+O40*2)/10000 / = (16591500·2+26064072·2)/10000 = 8531,1144 [смІ]
=ОКРУГЛ((N40*2+O40*2)/10000;3) / = (16591500·2+26064072·2)/10000,3) = 8531,114 [смІ]

YRat · 03.11.2011, 17:21

Э.. надеюсь, что ты сам это изменил. Я немножечко пропал)

SLADE · 03.11.2011, 20:50

вроде последний

Код:

[Выделить все]

 Function zFrml(i As Range) As String
Application.Volatile True 'Application.Volatile
Dim str As String
str = i.Formula
Set RegEx = CreateObject("vbscript.regexp")
str = Replace(str, "$", "")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = ",\d+\)|[ROUNDPWN]{4,10}\("
End With
str = RegEx.Replace(str, "")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "([A-Z]{1,2}\d{1,5})"
End With
str = RegEx.Replace(str, """&$1&""")
Set RegEx = Nothing
str = Replace(str, "*", Chr(183))
str = Replace(str, "=", "=""")
If (InStr(str, "&") = 2) Then str = Replace(str, "=&", "=")
If (InStr(str, """&") = 2) Then str = Replace(str, "=""&", "=")
If (InStrRev(str, "&") < Len(str)) Then str = str + "="""
If (InStrRev(str, "&") = Len(str)) Then str = str + """="""
str = Evaluate(str)
str = Replace(str, ".", ",")
zFrml = str
End Function



Function zFrml3(i As Range, units As String) As String
Application.Volatile True 'Application.Volatile
Dim str As String
str = i.Formula
str = Replace(str, "$", "")
Dim va As String
va = i.Value
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = ",\d+\)|[ROUNDPWN]{4,10}\("
End With
str = RegEx.Replace(str, "")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "(([A-Z]{1,2}\d{1,5})|(zZif\([A-Z]{1,2}\d{1,5}\)))"
End With
str = RegEx.Replace(str, """&$1&""")
Set RegEx = Nothing
str = Replace(str, "*", Chr(183))
str = Replace(str, "=", "=""= ")
If (InStr(str, "&") = 2) Then str = Replace(str, "=&", "=")
If (InStr(str, """&") = 2) Then str = Replace(str, "=""&", "=")
If (InStrRev(str, "&") < Len(str)) Then str = str + " = """
If (InStrRev(str, "&") = Len(str)) Then str = str + """ = """
str = str + "&" + i.Address
If (Len(units) > 0) Then str = str + "&"" [" + units + "]"""
str = Evaluate(str)
str = Replace(str, ".", ",")
zFrml3 = str
End Function






Function zZif(i As Range)
Application.Volatile True 'Application.Volatile
Dim str As String
str = i.Formula
str = Replace(str, "$", "")
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "=zFrml3\(([A-Z]{1,2}\d{1,5})+,[\d\D""]{2,5}"
End With
str = RegEx.Replace(str, "$1")
Set RegEx = Nothing
str = Range(str).Value
zZif = str
End Function
Option Base 1
Option Explicit
Public xj As Integer, yi As Integer

YRat · 03.11.2011, 21:26

И ты всё ещё пользуешься?)

SLADE · 04.11.2011, 12:10

привет, конечно!
почти ежедневно. еще прикупил программу PLEX, сейчас все летает

YRat · 09.11.2011, 12:32

SLADE, показать пример расчета и оформления можешь? Ато прямо любопытство берет)

SLADE · 10.11.2011, 00:28 **Привер**

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

YRat · 10.11.2011, 00:31

SLADE, мне и так достаточно, спасибо

Здорово получается! В первом забыл индексы поставить) Или забил)))

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Таблицы из Excel в AutoCAD вставляются неполностью	Nikolay_N	AutoCAD	23	07.09.2019 21:12
Excel - оформление формул	Добрыня	Разное	4	13.09.2007 20:39
Тексты из ACAD в Excel	miha	AutoCAD	9	18.04.2007 13:43
Проблемы в Excel	G.A.W.	Разное	11	27.02.2007 12:11
Как перенести информацию из табл. в Автокаде в Excel	Margarinchik	AutoCAD	9	29.11.2006 19:17