Основа алгоритма была взята с Википедии (http://ru.wikipedia.org/wiki/Обратная_польская_запись), код не оптимизирован. Если вставить этот код в модуль (*.bas), то эти функции можно будет вызывать как стандартные в Excel (необходимо в окне выбора функции выбрать "определенные пользователем")
Function Normal_to_POLIZ(InputString As String) As String - преобразовывает нормальную запись в ПОЛИЗ
InputString - выражение в нормальном ввиде (можно и с пробелами)
Function POLIZ_Solve(POLIZ_Expression As String) As Double - вычисление выражения написанного в ПОЛИЗ (для проверки)
POLIZ_Expression - выражение в в иде ПОЛИЗ, между числами и операторами разделитель пробел (" ") с другим разделителем работать не будет (можно исправить в функции Split)
Function Priority(Func As String) As Byte - функция определения приоритета операции (необходима для работы Normal_to_POLIZ)
| Код |
Option Explicit
Function Normal_to_POLIZ(InputString As String) As String
Dim OutLine As String
Dim Stack() As String
Dim Brick() As String
Dim Workstring As String
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim c4 As Integer
Dim c6 As Integer
Dim cS As Integer
Dim i As Integer
OutLine = ""
Workstring = ""
'Убираем пробелы
For i = 1 To Len(InputString)
If Mid(InputString, i, 1) <> " " Then Workstring = Workstring + Mid(InputString, i, 1)
Next
'Разбиваем выражение на элементы "число и "оператор"
c1 = 1
For i = 1 To Len(Workstring)
If IsNumeric(Mid(Workstring, i, 1)) Then
ReDim Preserve Brick(c1)
Brick(c1) = Brick(c1) + Mid(Workstring, i, 1)
Else
c1 = c1 + 1
ReDim Preserve Brick(c1)
Brick(c1) = Mid(Workstring, i, 1)
c1 = c1 + 1
End If
Next
'Построение выражения ПОЛИЗ (ПОЛьская Инверсная Запись
cS = 0
ReDim Stack(cS)
Stack(cS) = ""
For c3 = 1 To UBound(Brick)
If IsNumeric(Brick(c3)) Then
OutLine = OutLine + Brick(c3) + " "
Else
If Priority(Brick(c3)) > Priority(Stack(cS)) Then
cS = cS + 1
ReDim Preserve Stack(cS)
Stack(cS) = Brick(c3)
Else
OutLine = OutLine + Stack(cS) + " "
ReDim Preserve Stack(cS)
Stack(cS) = Brick(c3)
For c6 = cS To 1 Step -1
If Priority(Stack(c6)) <= Priority(Stack(c6 - 1)) Then
OutLine = OutLine + Stack(c6 - 1) + " "
Stack(c6 - 1) = Stack(c6)
cS = cS - 1
ReDim Preserve Stack(cS)
End If
Next
End If
End If
Next
For c4 = cS To 1 Step -1
OutLine = OutLine + Stack(c4) + " "
Next
'Вывод результата
Normal_to_POLIZ = OutLine
End Function
Function POLIZ_Solve(POLIZ_Expression As String) As Double
Dim BrickS() As String
Dim c7 As Integer
Dim c8 As Integer
Dim c9 As Integer
c9 = 0
c7 = 0
BrickS = Split(Trim(POLIZ_Expression))
Do Until UBound(BrickS) = 0 Or c7 = 100
If Not (IsNumeric(BrickS(c7))) Then
Select Case BrickS(c7)
Case "+"
BrickS(c7 - 2) = CDbl(BrickS(c7 - 2)) + CDbl(BrickS(c7 - 1))
BrickS(c7 - 1) = ""
BrickS(c7) = ""
Case "-"
BrickS(c7 - 2) = CDbl(BrickS(c7 - 2)) - CDbl(BrickS(c7 - 1))
BrickS(c7 - 1) = ""
BrickS(c7) = ""
Case "*"
BrickS(c7 - 2) = CDbl(BrickS(c7 - 2)) * CDbl(BrickS(c7 - 1))
BrickS(c7 - 1) = ""
BrickS(c7) = ""
Case "/"
BrickS(c7 - 2) = CDbl(BrickS(c7 - 2)) / CDbl(BrickS(c7 - 1))
BrickS(c7 - 1) = ""
BrickS(c7) = ""
Case "^"
BrickS(c7 - 2) = CDbl(BrickS(c7 - 2)) ^ CDbl(BrickS(c7 - 1))
BrickS(c7 - 1) = ""
BrickS(c7) = ""
End Select
For c8 = 0 To UBound(BrickS)
If BrickS(c8) <> "" Then
BrickS(c9) = BrickS(c8)
c9 = c9 + 1
End If
Next
ReDim Preserve BrickS(UBound(BrickS) - 2)
c7 = -1
c9 = 0
End If
c7 = c7 + 1
Loop
POLIZ_Solve = BrickS(0)
End Function
Function Priority(Func As String) As Byte
Priority = 0
Select Case Func
Case "^"
Priority = 3
Case "*"
Priority = 2
Case "/"
Priority = 2
Case "+"
Priority = 1
Case "-"
Priority = 1
End Select
End Function
|
|