VB - Avaliar uma expressão matemática de uma string
No VBA existe a função "Evaluate" (Avaliar) que tem como argumento uma fórmula estabelecida em uma variável alfanumérica, e retorna o resultado em uma variável alfanumérica.
No caso do VB, ela não existe, assim, vamos ter que implementá-la.
Eu coloquei essa demonstração em dica após uma pergunta no fórum, e penso que ela pode ajudar outras pessoas. Ela suporta cálculos simples +, -, * e /, assim como os parênteses. As funções são feitas de tal modo que é muito fácil adicionar tipos tais como o Sqr ^, etc.
A demonstração funciona da mesma maneira que o "Evaluate", o envio da fórmula em alfanumérico, retorno do resultado em alfanumérico, tipo de cálculo igual ao da imagem.
Este sub é usado somente para o teste.
Sub TesteCálculo()
Dim A As String
Dim Ret As String
A = "(((3*(12.223+ 15)) - 7)*21)/7"
Ret = Evaluer(A)
'Debug.Print Ret
'= 224.007
A = "((123.32/2.67)*6)+2127.34"
Ret = Avaliar(A)
'=2404.46359550562
'Debug.Print Ret
End Sub
O código das funções
Function Avaliar(ByVal Txt As String) As String
Dim i As Integer, oNB As Integer, fNB As Integer
Dim P1 As Integer, P2 As Integer
Dim Buff As String
Dim T As String
'Para os cálculos botar um ponto no lugar da vírgula
Txt = Replace(Txt, ",", ".")
'Ver se há "( "
For i = 1 To Len(Txt)
If Mid(Txt, i, 1) = "(" Then oNB = oNB + 1
Next i
'Se houver "(" (de abertura), ver se foram validados por ")" (de fechamento)
If oNB > 0 Then
For i = 1 To Len(Txt)
If Mid(Txt, i, 1) = ")" Then fNB = fNB + 1
Next i
Else
'Sem parênteses, Avalia o cálculo diretamente
Avaliar = EvalueExpression(Txt)
Exit Function
End If
If oNB <> fNB Then
'Os parênteses não são concordantes, pôr mensagem de erro entre parênteses
Exit Function
End If
While oNB > 0
'busca o último parêntese de abertura
P1 = InStrRev(Txt, "(")
'busca o parêntese de fechamento da expressão
P2 = InStr(Mid(Txt, P1 + 1), ")")
'Avalia a expressão que está entre parênteses
Buff = EvalueExpression (Mid(Txt, P1 + 1, P2 - 1))
'Substituir a expressão pelo resultado e tirar os parênteses
Txt = Left(Txt, P1 - 1) & Buff & Mid(Txt, P1 + P2 + 1)
oNB = oNB - 1
Wend
'sem parêntese, avaliar a última expressão
Avaliar = EvalueExpression(Txt)
End Function
Function EvalueExpression(A As String) As String
Dim T As Integer, S As Integer
Dim B As String, i As Integer, C As Boolean
Dim c1 As Double, c2 As Double, Signe As Integer
Dim R As String, Fin As Boolean, z As Integer
'remover os espaços
A = Replace(A, " ", "")
While Not Fin
For i = 1 To Len(A)
T = Asc(Mid(A, i, 1))
If T < 48 And T <> 46 Or i = Len(A) Then
If C Then 'avaliar
If i = Len(A) Then
c2 = Val(Mid(A, S))
Else
c2 = Val(Mid(A, S, i - S))
End If
R = Str(CálculoSimples(c1, c2, Signe))
If i = Len(A) Then
Fim = True
Else
A = Trim(R & Mid(A, i))
C = False
End If
Exit For
Else 'separa o 1° número
c1 = Val(Left(A, i - 1))
Signe = T
S = i + 1
C = True
End If
End If
Next i
Wend
'substituir a expressão pelo resultado
EvalueExpression = Trim(R)
End Function
Na função abaixo é possível adicionar cálculos diferentes
Function CálculoSimples(n1 As Double, n2 As Double, Signe As Integer) As Double
Select Case Signe
Case 43 ' +
CálculoSimples = n1 + n2
Case 45 ' -
CálculoSimples = n1 - n2
Case 42 ' *
CálculoSimples = n1 * n2
Case 47 ' /
CálculoSimples = n1 / n2
'Aqui, adicionar outro cálculo...
End Select
End Function
Nota: Para que isso concorde perfeitamente com a calculadora, é preciso, em primeiro lugar avaliar a função "*" e "/" , e só aí então o "+" e o "-".
Exemplo 3+5*7
A calculadora terá como resultado 5*7 = 35 + 3 = 38
Aqui isso vai dar 3+5=8 *7 = 56
Você pode modificar a função "EvalueExpression" ou por o cálculo sob a forma 3+(5*7) que vai dar 38.
É possível que haja bugs em certas condições, você pode me enviar os seus comentários e/ou um relatório d erro em MP.
- VB - Avaliar uma expressão matemática de uma string
- Avaliar pc online - Dicas -Profissionais
- Jogos de matemática - adição e subtração, contagem - Downloads - Videogames
- Concatenar string matlab - Dicas -Softwares
- Simbolo pi matematica - Dicas -Suíte de escritório
- Concatenação de string javascript - Dicas -Javascript
Assine nossa newsletter!
