Code:
'10 ' http://www.eileenslounge.com/viewtopic.php?f=27&t=22850#p208624
Function CStrSepDbl(Optional ByVal strNumber As String) As Double ' Return a Double based on a String Input which is asssumed to "Look" like a Number. The code will work for Leading and Trailing zeros, but will not return them. )
20 Rem 0 At the Dim stage a '_-String is "Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks, But http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
30 If StrPtr(strNumber) = 0 Then Let CStrSepDbl = "9999999999": Exit Function '_- StrPtr(MyVaraibleNotYetUsed)=0 .. http://www.excelfox.com/forum/showthread.php/1828-How-To-React-To-The-Cancel-Button-in-a-VB-(not-Application)-InputBox?p=10463#post10463 https://www.mrexcel.com/forum/excel-questions/35206-test-inputbox-cancel-2.html?highlight=strptr#post2845398 https://www.mrexcel.com/forum/excel-questions/917689-passing-array-class-byval-byref.html#post4412382
40 Rem 1 'Adding a leading zero if no number before a comma or point, change all seperators to comma ,
50 If VBA.Strings.Left$(strNumber, 1) = "," Or VBA.Strings.Left$(strNumber, 1) = "." Then Let strNumber = "0" & strNumber ' case for like .12 or ,7 etc 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm -bit iffy although you could argue that Null has not been entered yet..may never
60 If VBA.Strings.Left$(strNumber, 2) = "-," Or VBA.Strings.Left$(strNumber, 2) = "-." Then Let strNumber = Application.WorksheetFunction.Replace(strNumber, 1, 1, "-0") ' case for like -.12 or -,274 etc
70 Let strNumber = Replace(strNumber, ".", ",", 1, -1, vbBinaryCompare) 'Replace at start any . to a , After this point there should be either no or any amount of ,
80 'Check If a Seperator is present, then MAIN CODE is done
90 If InStr(1, strNumber, ",") > 0 Then 'Check we have at least one seperator, case we have, then..
100 Rem 2 'MAIN CODE part ====
110 'Length of String: Position of last ( Decimal ) Seperator
120 Dim LenstrNumber As Long: Let LenstrNumber = Len(strNumber): Dim posDecSep As Long: Let posDecSep = VBA.Strings.InStrRev(strNumber, ",", LenstrNumber) ' from right the positom "along" from left ( (in strNumber) , for a (",") , starting at the ( Last character ) which BTW. is the default
130 'Whole Number Part
140 Dim strHlNumber As String: Let strHlNumber = VBA.Strings.Left$(strNumber, (posDecSep - 1))
150 Let strHlNumber = Replace(strHlNumber, ",", Empty, 1, -1) 'In (strHlNumber) , I look for a (",") , and replace it with "VBA Nothing there" , considering and returning the strNumber from the start of the string , and replace all occurances ( -1 ).
160 Dim HlNumber As Long: Let HlNumber = CLng(strHlNumber) 'Long Number is a Whole Number, no fractional Part
170 'Fraction Part of Number
180 Dim strFrction As String: Let strFrction = VBA.Strings.Mid$(strNumber, (posDecSep + 1), (LenstrNumber - posDecSep)) 'Part of string (strNumber ) , starting from just after Decimal separator , and extending to a length of = ( the length of the whole strNumber minus the position of the separator )
190 Dim LenstrFrction As Long: Let LenstrFrction = Len(strFrction) 'Digits after Seperator. This must be done at the String Stage, as length of Long, Double etc will allways be 8, I think?.
200 Dim Frction As Double: Let Frction = CDbl(strFrction) 'This will convert to a Whole Double Number. Double Number can have Fractional part
210 Let Frction = Frction * 1 / (10 ^ (LenstrFrction)) 'Use 1/___, rather than a x 0.1 or 0,1 so as not to add another , . uncertainty!!
220 'Re join, using Maths to hopefully get correct Final Value
230 Dim DblReturn As Double 'Double Number to be returned in required Format after maniplulation.
240 If Left(strHlNumber, 1) <> "-" Then 'Case positive number
250 Let DblReturn = CDbl(HlNumber) + Frction 'Hopefully a simple Mathematics + will give the correct Double Number back
260 Else 'Case -ve Number
270 Let strHlNumber = Replace(strHlNumber, "-", "", 1, 1, vbBinaryCompare) ' strHlNumber * (-1) ' "Remove" -ve sign
280 Let DblReturn = (-1) * (CDbl(strHlNumber) + Frction) 'having constructed the value of the final Number we multiply by -1 to put the Minus sign back
290 End If 'End checking polarity.
300 'Final Code Line(s) At this point we have what we want. We need to place this in the "Double Type variable" , CStrSepDbl , so that an assinment like = CStrSepDbl( ) will return this final value
310 Let CStrSepDbl = DblReturn 'Final Double value to be returned by Function
320 Else 'End MAIN CODE. === We came here if we have a Whole Number with no seperator, case no seperator
330 'Simple conversion of a string "Number" with no Decimal Seperator to Double Format
340 Let CStrSepDbl = CDbl(strNumber) 'String to be returned by Function is here just a simple convert to Double ' I guess this will convert a zero length string "" to 0 also
350 End If 'End checking for if a Seperator is present.
End Function
'Long code lines: Referrences http://www.mrexcel.com/forum/about-board/830361-board-wish-list-2.html http://www.mrexcel.com/forum/test-here/928092-http://www.eileenslounge.com/viewtopic.php?f=27&t=22850
Function CStrSepDblshg(strNumber As String) As Double ' http://excelxor.com/2014/09/05/index-returning-an-array-of-values/ http://www.techonthenet.com/excel/formulas/split.php
5 If Left(strNumber, 1) = "," Or Left(strNumber, 1) = "." Then Let strNumber = "0" & strNumber
20 Let strNumber = Replace(strNumber, ".", ",", 1, -1)
40 If InStr(1, strNumber, ",") > 0 Then
170 If Left(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1), 1) <> "-" Then
180 Let CStrSepDblshg = CDbl(CLng(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1))) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber)))))))
190 Else
210 Let CStrSepDblshg = (-1) * (CDbl(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1) * (-1)) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))))))
220 End If
250 Else
270 Let CStrSepDblshg = CDbl(strNumber)
280 End If
End Function
Demo Code to call Function
Reply With Quote
Bookmarks