Function CurrencyToNumber(ByVal CurrencyString As String, Optional ByVal DecimalSeparator As String = ".", Optional ByVal ThousandsSeparator As String = ",") As Double
Dim csLen As Long: csLen = Len(CurrencyString)
Select Case csLen
Case 0
Exit Function ' vbNullString
Case 1
If IsNumeric(CurrencyString) Then
CurrencyToNumber = CDbl(CurrencyString)
End If
Case Else
Dim rString As String
Dim csStart As Long
If Left(CurrencyString, 1) = "-" Then
rString = "-"
csStart = 2
Else
csStart = 1
End If
Dim cPos As Long
Dim cChar As String
Dim dsFound As Boolean
For cPos = csStart To csLen
cChar = Mid(CurrencyString, cPos, 1)
Select Case cChar
Case DecimalSeparator
If dsFound = False Then
rString = rString & DecimalSeparator
dsFound = True
Else
Exit Function ' two decimal separators
End If
Case ThousandsSeparator
Case Else
If IsNumeric(cChar) Then
rString = rString & cChar
Else
' neither ds, ts nor digit
End If
End Select
Next cPos
If IsNumeric(rString) Then
CurrencyToNumber = CDbl(rString)
End If
End Select
End Function
Sub CurrencyToNumberTEST()
Const ExamplesList As String = "|1|abc|$12.34|-5kn|-56.78|1,005.67|34.67.56"
Dim Examples() As String: Examples = Split(ExamplesList, "|")
Dim n As Long
For n = 0 To UBound(Examples)
Cells(n + 2, "A").Value = CurrencyToNumber(Examples(n))
Debug.Print n, CurrencyToNumber(Examples(n))
Next n
End Sub
ورود به سایت