Advertisement
AlanElston

Function CStrSepDbl Excel VBA comma point thousand decimal s

Feb 17th, 2018
657
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 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
  2. Dim LooksLikeANumber(1 To 17) As String
  3.  Let LooksLikeANumber(1) = "001,456"
  4.  Let LooksLikeANumber(2) = "1.0007"
  5.  Let LooksLikeANumber(3) = "123,456.2"
  6.  Let LooksLikeANumber(4) = "0023.345,0"
  7.  Let LooksLikeANumber(5) = "-0023.345,0"
  8.  Let LooksLikeANumber(6) = "1.007"
  9.  Let LooksLikeANumber(7) = "1.3456"
  10.  Let LooksLikeANumber(8) = "1,2345"
  11.  Let LooksLikeANumber(9) = "01,0700000"
  12.  Let LooksLikeANumber(10) = "1.3456"
  13.  Let LooksLikeANumber(11) = "1,2345"
  14.  Let LooksLikeANumber(12) = ".2345"
  15.  Let LooksLikeANumber(13) = ",4567"
  16.  Let LooksLikeANumber(14) = "-,340"
  17.  Let LooksLikeANumber(15) = "00.04"
  18.  Let LooksLikeANumber(16) = "-0,56000000"
  19.  Let LooksLikeANumber(17) = "-,56000001"
  20. Dim Stear As Variant, MyStringsOut As String
  21.     For Each Stear In LooksLikeANumber()
  22.     Dim Retn As Double
  23.      Let Retn = CStrSepDbl(Stear)
  24.     Dim TabulatorSyncranartor As String: Let TabulatorSyncranartor = "                         "
  25.      LSet TabulatorSyncranartor = Stear
  26.      Let MyStringsOut = MyStringsOut & TabulatorSyncranartor & Retn & vbCrLf
  27.      Debug.Print Stear; Tab(15); Retn
  28.     Next Stear
  29.  MsgBox MyStringsOut
  30. End Sub
  31. '10   '   http://www.eileenslounge.com/viewtopic.php?f=27&t=22850#p208624
  32. 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. )
  33. 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
  34. 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
  35. 40   Rem 1  'Adding a leading zero if no number before a comma or point, change all seperators to comma  ,
  36. 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
  37. 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
  38. 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 ,
  39. 80     'Check If a Seperator is present, then MAIN CODE is done
  40. 90     If InStr(1, strNumber, ",") > 0 Then 'Check we have at least one seperator, case we have, then..
  41. 100  Rem 2 'MAIN CODE part ====
  42. 110    'Length of String:  Position of last ( Decimal ) Seperator
  43. 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
  44. 130    'Whole Number Part
  45. 140    Dim strHlNumber As String: Let strHlNumber = VBA.Strings.Left$(strNumber, (posDecSep - 1))
  46. 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 ).
  47. 160    Dim HlNumber As Long: Let HlNumber = CLng(strHlNumber) 'Long Number is a Whole Number, no fractional Part
  48. 170    'Fraction Part of Number
  49. 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 )
  50. 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?.
  51. 200    Dim Frction As Double: Let Frction = CDbl(strFrction) 'This will convert to a Whole Double Number. Double Number can have  Fractional part
  52. 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!!
  53. 220    'Re join, using Maths to hopefully get correct Final Value
  54. 230    Dim DblReturn As Double 'Double Number to be returned in required Format after maniplulation.
  55. 240         If Left(strHlNumber, 1) <> "-" Then 'Case positive number
  56. 250          Let DblReturn = CDbl(HlNumber) + Frction 'Hopefully a simple Mathematics + will give the correct Double Number back
  57. 260         Else 'Case -ve Number
  58. 270          Let strHlNumber = Replace(strHlNumber, "-", "", 1, 1, vbBinaryCompare) ' strHlNumber * (-1) ' "Remove" -ve sign
  59. 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
  60. 290         End If 'End checking polarity.
  61. 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
  62. 310     Let CStrSepDbl = DblReturn 'Final Double value to be returned by Function
  63. 320    Else 'End MAIN CODE. === We came here if we have a Whole Number with no seperator, case no seperator
  64. 330    'Simple conversion of a string "Number" with no Decimal Seperator to Double Format
  65. 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
  66. 350    End If 'End checking for if a Seperator is present.
  67. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement