Option
Explicit
Public
Sub
Main()
Dim
dblA
As
Double
, dblB
As
Double
Dim
strValA
As
String
, strValB
As
String
, _
strFunc
As
String
dblA = 6.867
dblB = 2.2
If
Not
dblA =
CDbl
(
CInt
(dblA))
Then
strValA = Replace$(
CStr
(dblA),
","
,
";"
, 1)
Else
strValA =
CStr
(dblA)
End
If
If
Not
dblB =
CDbl
(
CInt
(dblB))
Then
strValB = Replace$(
CStr
(dblB),
","
,
";"
, 1)
Else
strValB =
CStr
(dblB)
End
If
strFunc =
"fncArrResult"
&
"("
& strValA &
","
& strValB &
")"
Call
prcRunFunc(strFunc)
End
Sub
Private
Sub
prcRunFunc(strFunc
As
String
)
Dim
vntArrReturn
As
Variant
vntArrReturn = Application.Run(Mid$(strFunc, 1, InStr(1, strFunc,
"("
, vbTextCompare) - 1), _
CDbl
(Replace$(Mid$(strFunc, InStr(1, strFunc,
"("
, vbTextCompare) + 1, InStr(1, strFunc,
","
, vbTextCompare) - 1 - InStr(1, strFunc,
"("
, vbTextCompare)),
";"
,
","
, 1)), _
CDbl
(Replace$(Mid$(strFunc, InStr(1, strFunc,
","
, vbTextCompare) + 1, InStr(1, strFunc,
")"
, vbTextCompare) - 1 - InStr(1, strFunc,
","
, vbTextCompare)),
";"
,
","
, 1)))
MsgBox
"Ergebnis: "
&
CDbl
(vntArrReturn(1)) & vbCr & _
"Fehler: "
&
CBool
(vntArrReturn(2))
End
Sub
Private
Function
fncArrResult(dblA
As
Double
, dblB
As
Double
)
As
Variant
()
Dim
vntArrTemp(1
To
2)
As
Variant
On
Error
GoTo
Sub_Exit
vntArrTemp(1) = dblA / dblB
vntArrTemp(2) =
False
Sub_Exit:
If
Err.Number <> 0
Then
vntArrTemp(1) = Empty
vntArrTemp(2) =
True
End
If
fncArrResult = vntArrTemp
End
Function