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-надстройка. Для чего? Для форматирования текста в ячейках. В паре с вышеперечисленными функциями дает неплохой вариант оформления.
В общем-то на миниатюре видно как оно всё выглядит, тратить времени на это форматирование я стал меньше, факт

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