Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub TestieCStrSepDbl() ' using adeptly named TabulatorSyncranartor ' / Introducing LSet TabulatorSyncranartor Statement : http://www.excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings
- Dim LooksLikeANumber(1 To 17) As String
- Let LooksLikeANumber(1) = "001,456"
- Let LooksLikeANumber(2) = "1.0007"
- Let LooksLikeANumber(3) = "123,456.2"
- Let LooksLikeANumber(4) = "0023.345,0"
- Let LooksLikeANumber(5) = "-0023.345,0"
- Let LooksLikeANumber(6) = "1.007"
- Let LooksLikeANumber(7) = "1.3456"
- Let LooksLikeANumber(8) = "1,2345"
- Let LooksLikeANumber(9) = "01,0700000"
- Let LooksLikeANumber(10) = "1.3456"
- Let LooksLikeANumber(11) = "1,2345"
- Let LooksLikeANumber(12) = ".2345"
- Let LooksLikeANumber(13) = ",4567"
- Let LooksLikeANumber(14) = "-,340"
- Let LooksLikeANumber(15) = "00.04"
- Let LooksLikeANumber(16) = "-0,56000000"
- Let LooksLikeANumber(17) = "-,56000001"
- Dim Stear As Variant, MyStringsOut As String
- For Each Stear In LooksLikeANumber()
- Dim Retn As Double
- Let Retn = CStrSepDbl(Stear)
- Dim TabulatorSyncranartor As String: Let TabulatorSyncranartor = " "
- LSet TabulatorSyncranartor = Stear
- Let MyStringsOut = MyStringsOut & TabulatorSyncranartor & Retn & vbCrLf
- Debug.Print Stear; Tab(15); Retn
- Next Stear
- MsgBox MyStringsOut
- End Sub
- '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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement