I am trying to make a certain string with Digits change form, so that it looks like below.
Modified to show with Digits instead of X.
So let´s set, i get a number, like this.
234.123123123
I need to change how it appears, for 3 digits before a Dot, it would need to become.
0.234123123123
And let´s say it´s 2.23123123123, that would become, 0.0023123123123
Now i will try to explain the Formula, bare with my English.
The formula needs to change the position of the Dot ".".
You can see that it changes place, But you can also see that i am adding 0s.
That is important, the 0s needs to be added IF the dot get´s to the far left (the beginning of the string).
So how much must the Dot move?
The Dot must Always move 3 steps to the left.
And if it hit´s the wall (the start of the string) you need to add 0s, and then one 0s before the dot.
So if the number is, 2.222222
I will first have to move the dot to the left, let´s show step by step.
Step 1:
.2222222
Step 2:
.02222222
Step 3:
0.02222222
It must Always be a 0 Before the Dot, it it ever hit the Start.
It sounds more complicated then it is, it´s just that i don't know how to explain it.
EDIT:
My attempt:
TextPos = InStr(1, TextBox4.Value, ".") - 2
If (TextPos = 4) Then
sLeft = Left(TextBox4.Value, Len(TextBox4.Value) - Len(TextBox4.Value) + 2)
sRight = Right(TextBox4.Value, Len(TextBox4.Value) - 2)
sFinal = (sLeft & "." & Replace(sRight, ".", ""))
TextBox4.Value = Replace(sFinal, "-", "")
End If
If (TextPos = 3) Then
TextBox4.Value = "0." + Replace(TextBox4.Value, ".", "")
End If
If (TextPos = 2) Then
TextBox4.Value = "0.0" + Replace(TextBox4.Value, ".", "")
End If
If (TextPos = 1) Then
TextBox4.Value = "0.00" + Replace(TextBox4.Value, ".", "")
End If
TextBox4.Value = Replace(TextBox4.Value, "-", "")
If i /1000 it, may work, but it seems like it will alter the number, leaving it to fail.
Original: 25.1521584671082
/1000 : 2.51521584671082E-02
As you can see, it doesn't work as expected.
It should become 0.0251521584671082E-02 (And of course i don't want " E- " to be there.
So if it's possible to do this, but ONLY moving and not actually, dividing (i think excel is limited to how many numbers it can calculate with) then it will work.
Worth Noting, the numbers shown are actually less (shorter) then the real number for some reason, if i write it down to a text file, it becomes this:
2.51521584671082E-02251521584671082E-02
So as you can see, i probably hit a Wall in the calculation, so it changes to Characters (I know math uses those, but no idea what they mean, and they are useless for me anyway).
And i think it's because of them that it fails, not sure though.
EDIT:
Okay, by limiting to 15 decimals it will return the correct place, but i would like not to do this round about, should Excel really be limited to only 15 Decimals, or is it "Double,Float etc" that does this?
EDIT 2:
Tony's example provides this:
Original: 177.582010543847177582010543847
Tony's: 0.1775820110177582011
Round(15decimals): 0.1775820105438470177582010543847
Not really sure, but isn't it Incorrect, or perhaps i did something wrong?
If possible, i want ALL decimals and number to stay in place, as everything is already correct, it's just that they are in the wrong place.
/1000 solves this, but not in the best way, as it will recalculate instead of just moving.
Normally i wouldn't care, the results are the same, but here it does matter as you can see.
I can however think of a solution, where i till look for the position of the Dot, then cut out the last decimals, divide the Result by 1000, then later add the last decimals, though that is more of a hack , not sure if it will actually work.
I conclude that this is Answered, it does what i want, and the limitations is in the Calculation itself, not the Solution.
All Solutions work pretty much in the same way, but i chose Tony's as he was first to comment the solution in my question.
Many Thanks everyone!
It appears to me through all your edits that you want to divide the number by one thousand. To do this, you can simply use
TextBox4.Value = TextBox4.Value / 1000
You code sometimes fails because it does not handle every situation. You calculate TextPos so:
TextPos = InStr(1, TextBox4.Value, ".") - 2
You then handle TextPos being 4, 3, 2 or 1. But if, for example, TextBox4.Value = "2.22222" then TextPos = 0 and you have no code for that situation.
At 11:45 GMT, I suggested in a comment that dividing by 1000 would give you the result you seek. At 14:08 GMT, tunderblaster posted this as an answer. It is now 15:23 but you have not responded to either of us.
Having tried your code, I now know these answer do not match the result it gives when it works because you remove the sign. The following would give you almost the same as a working version of your code:
TextBox4.Value = Format(Abs(Val(TextBox4.Value)) / 1000, "#,##0.#########")
The only deficiency with this statement is that it does not preserve all the trailing decimal digits. Is this really important?
While I was preparing and posting this answer, you edited your question to state that dividing by 1000 would sometimes give the result in scientific format. My solution avoids that problem.
If you want to avoid floating point error when dividing by 10, you may use the Decimal type
Private Sub CommandButton1_Click()
Dim d As Variant
d = CDec(TextBox1.Text)
TextBox1.Text = d / 1000
End Sub
Is this what you are trying?
Sub Sample()
Dim sNum As String, SFinal As String
Dim sPref As String, sSuff As String
Dim nlen As Long
sNum = "234.123123123123123123131231231231223123123"
SFinal = sNum
If InStr(1, sNum, ".") Then
sPref = Trim(Split(sNum, ".")(0))
sSuff = Trim(Split(sNum, ".")(1))
nlen = Len(sPref)
Select Case nlen
Case 1: SFinal = ".00" & Val(sPref) & sSuff
Case 2: SFinal = ".0" & Val(sPref) & sSuff
Case 3: SFinal = "." & Val(sPref) & sSuff
End Select
End If
Debug.Print SFinal
End Sub
Try this. It works by initialy padding the string with leading 0's, shifting the DP, then removing any unnecassary remaining leading 0's
Function ShiftDecimalInString(str As String, Places As Long) As String
Dim i As Long
If Places > 0 Then
' Move DP to left
' Pad with leading 0's
str = Replace$(Space$(Places), " ", "0") & str
' Position of .
i = InStr(str, ".")
str = Replace$(str, ".", "")
If i > 0 Then
' Shift . to left
str = Left$(str, i - Places - 1) & "." & Mid$(str, i - Places)
' strip unnecassary leading 0's
Do While Left$(str, 2) = "00"
str = Mid$(str, 2)
Loop
If str Like "0[!.]*" Then
str = Mid$(str, 2)
End If
ShiftDecimalInString = str
Else
' No . in str
ShiftDecimalInString = str
End If
ElseIf Places < 0 Then
' ToDo: Handle moving DP to right
Else
' shift DP 0 places
ShiftDecimalInString = str
End If
End Function
This "answer" responses to the issue that you want as much precision in the result as possible.
When I was at school this was called spurious accuracy. I have forgotten most of my mathematics in this area but I will try to give you an understanding of the issue.
I have a value, 2.46, which is accurate to 2 decimal places. That is the true value is somewhere in the range 2.455 to 2.465.
If I feed these values into a square root function I will get:
sqrt(2.455) = 1.566843961599240
sqrt(2.46) = 1.568438714135810
sqrt(2.465) = 1.570031846810760
From this I see the square root of the true value is somewhere between 1.567 and 1.570; any extra decimal digits are spurious.
If I understand correctly, you wish to use these numbers to make adjustments. Are you capable of making adjustments to 15 decimal digits?
If you remember your calculus you can look up "propogation of error" for a better explanation.
Related
I searched everywhere for a way to sort Myanmar names, typed up in Pyidaungsu unicode font, by the last consonant in MS Excel.
Doing the same in English is relatively easy using Excel's builtin formulae/functions.
But it is hard for Myanmar names in Burmese because Myanmar names do not require a white space between each word and the first, middle and last names are not that distinct as in, eg. John W. Smith.
In a Myanmar name, eg. အောင်မြင့်မြတ်=Aung Myint Myat, there is no distinct first/last name and no white space is required if it is written in Myanmar font!
Thus, it is pretty hard to find the word boundary between each word, i.e, where အောင် starts and ends and မြင့် starts and ends etc. and so on!
So I need a VBA UDF to be able to tokenize Myanmar names!
After much searching and reading through NLP literature, a lot of which I don't really understand, I realized that the Myanmar font, Pyidaungsu by name, has a character binding method where all Myanmar characters: consonants and diacritics were bound together like: the consonants come first for each word, followed by diacritics (or may be I am wrong about how it is called).
So if only I could place a delimiter/separator just before each consonant, I should be able to tokenize each word!
Fortunately, it helps me write VBA code like:
Const kagyi = 4096
Const ah = 4129 '+9 to include ou
Const athat = 4154
Const shiftF = 4153 'for typing something under something
Const witecha = 4140
Const moutcha = 4139
'Return a tokenized Myanmar String
Function MMRTokenizer(target As Range) As String
Dim ch As String
Dim returnString As String
Dim charCounter As Integer
Dim previousChIsAthat As Boolean
Dim shiftFfound As Boolean
Dim previousCharAt As Long
If target.Cells.CountLarge > 1 Then MMRTokenizer = ">1Cell!": Exit Function
returnString = "": previousChIsAthat = False: shiftFfound = False: previousCharAt = Len(target.Value) + 1
If target.CountLarge = 1 Then
If target.Value <> "" Then
For charCounter = Len(target.Value) To 1 Step -1
ch = Mid(target.Value, charCounter, 1)
If AscW(ch) <> shiftF Then
If Not shiftFfound Or AscW(ch) = athat Then
If AscW(ch) <> athat Then
If AscW(ch) >= kagyi And AscW(ch) < ah + 9 Then
If Not previousChIsAthat Then
returnString = Mid(target.Value, charCounter, previousCharAt - charCounter) & IIf(Len(returnString) > 0, "|", "") & returnString
previousCharAt = charCounter
Else
previousChIsAthat = False
End If
Else
If AscW(ch) = witecha Or AscW(ch) = moutcha Then
previousChIsAthat = False
End If
End If
Else
previousChIsAthat = True
If shiftFfound Then shiftFfound = False
End If
Else
shiftFfound = False
If previousChIsAthat Then previousChIsAthat = False
End If
Else
shiftFfound = True
End If
Next charCounter
End If
End If
MMRTokenizer = returnString
End Function
In theory, it should be pretty simple since I am not using any NLP or ML methods but employed some string manipulations only.
I took out each character of the name/word from the right (it may be ok to start from the left) then go left until I found a consonant and place a separator/delimiter to the left of it and then keep going left and repeating the same process until the left-most character is reached.
The caveat here is, that, sometimes, there could be a consonant, which in Myanmar language is part of a combination of a consonant and a diacritic (pretty common behavior), eg. in အောင်=ေ+အ+ ာ+င+် though it looks like that way, the Pyidaungsu font bound it like အ+ေ+ာ+င+် ,if it were entered using Windows Burmese keyboard (Visual Order), the rightmost two, င+် where င=consonant called nga and ် =diacritic called Athat.
In such cases, we just skip over that renegade consonant (if we encountered that specific diacritic just right of it) as it should not be counted as such, according the Burmese way of spelling words.
I used chrW and ascW functions because Myanmar font cannot be rendered in VBIDE (even after tweaking in the Regional settings) and thus, I am forced to check the unicode character codes instead of directly comparing Burmese characters.
Above is just a gist of how the whole thing works.
Further details are available on my GitHub.
After we tokenized like above, we got something like: အောင်|မြင့်|မြတ် which is now pretty easy to be splitted up or reversed using builtin Excel formulae to become မြတ်|မြင့်|အောင် so that it can now be sorted by the last word (or last name) or separated into a last name/first name basis!
NB: This whole tokenization process could/may be achieved by using a combination of various formulae in Excel as nothing is impossible, especially in Excel365 (where arrays just spill without CSE), IMHO, however, I hope that we can easily see the benefits vs. complexity and effort in this case.
I, hereby, admit that the above code may not be the most elegant, but, it is a proven-working proof-of-concept tool, so employ it at your own risk but bugs can be reported to my GitHub provided above.
I have the following Text sample:
Ins-Si_079_GM_SOC_US_VI SI_SOC_FY1920_US_FY19/20_A2554_Si Resp_2_May
I want to get the number 079, So what I need is the first instance of digits of length 3. There are certain times the 3 digits are at the end, but they usually found with the first 2 underscores. I only want the digits with length three (079) and not 19, 1920, or 2554 which are different lengths.
Sometimes it can look like this with no underscore:
1920 O-B CLI 353 Tar Traf
Or like this with the 3 digit number at the end:
Ins-Si_GM_SOC_US_VI SI_SOC_FY1920_US_FY19/20_A2554_Si Resp_2_079
There are also times where what I need is 2 digits but when it's 2 digits its always at the end like this:
FY1920-Or-OLV-B-45
How would I get what I need in all cases?
You can split the listed items and check for 3 digits via Like:
Function Get3Digits(s As String) As String
Dim tmp, elem
tmp = Split(Replace(Replace(s, "-", " "), "_", " "), " ")
For Each elem In tmp
If elem Like "###" Then Get3Digits = elem: Exit Function
Next
If Get3Digits = vbNullString Then Get3Digits = IIf(Right(s, 2) Like "##", Right(s, 2), "")
End Function
Edited due to comment:
I would execute a 2 digit search when there are no 3 didget numbers before the end part and the last 2 digits are 2. if 3 digits are fount at end then get 3 but if not then get 2. there are times when last is a number but only one number. I would only want to get last if there are 2 or 3 numbers. The - would not be relevant to the 2 digets. if nothing is found that is desired then would return " ".
If VBA is not a must you could try:
=TEXT(INDEX(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"_"," "),"-"," ")," ","</s><s>")&"</s></t>","//s[.*0=0][string-length()=3 or (position()=last() and string-length()=2)]"),1),"000")
It worked for your sample data.
Edit: Some explaination.
SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"_"," "),"-"," ")," ","</s><s>") - The key part to transform all three potential delimiters (hyphen, underscore and space) to valid XML node end- and startconstruct.
The above concatenated using ampersand into a valid XML construct (adding a parent node <t>).
FILTERXML can be used to now 'split' the string into an array.
//s[.*0=0][string-length()=3 or last() and string-length()=2] - The 2nd parameter of FILTERXML which should be valid XPATH syntax. It reads:
//s 'Select all <s> nodes with
following conditions:
[.*0=0] 'Check if an <s> node times zero
returns zero (to check if a node
is numeric. '
[string-length()=3 or (position()=last() and string-length()=2)] 'Check if a node is 3 characters
long OR if it's the last node and
only 2 characters long.
INDEX(.....,1) - I mentioned in the comments that usually this is not needed, but since ExcelO365 might spill the returned array, we may as well implemented to prevent spilling errors for those who use the newest Excel version. Now we just retrieving the very first element of whatever array FILTERXML returns.
TEXT(....,"000") - Excel will try delete leading zeros of a numeric value so we use TEXT() to turn it into a string value of three digits.
Now, if no element can be found, this will return an error however a simple IFERROR could fix this.
Try this function, please:
Function ExtractThreeDigitsNumber(x As String) As String
Dim El As Variant, arr As Variant, strFound As String
If InStr(x, "_") > 0 Then
arr = Split(x, "_")
Elseif InStr(x, "-") > 0 Then
arr = Split(x, "-")
Else
arr = Split(x, " ")
End If
For Each El In arr
If IsNumeric(El) And Len(El) = 3 Then strFound = El: Exit For
Next
If strFound = "" Then
If IsNumeric(Right(x, 2)) Then ExtractThreeDigitsNumber = Right(x, 2)
Else
ExtractThreeDigitsNumber = strFound
End If
End Function
It can be called in this way:
Sub testExtractThreDig()
Dim x As String
x = "Ins-Si_079_GM_SOC_US_VI SI_SOC_FY1920_US_FY19/20_A2554_Si Resp_2_May"
Debug.Print ExtractThreeDigitsNumber(x)
End Sub
basically, I need to find a way to check if a String variable contains another String variable(or preferably an item from an array). Here's my case:
I have a list of 15k+ Strings in Excel, and another one with 5k+ Strings.The Second list is composed of 3 character long abbreviations, and the first one might contain from 0 to 15 of those, separated by ", ". My goal is to count each occurrence, of each of those abbreviations.
I've approached this by creating an array containing all the abbreviations. Then I was hoping to loop through the 15k+ long list 5k+ times, to count the occurrences of each of those abbreviations, changing the abbreviation sought every loop. However I'm stuck with comparing the strings...
I've tried to use InStr to see if I get 0 or not. Although it worked for me before when I referred to a String being searched by variable, but it seems that expression sought can't be placed in such a way. I've been trying to use Find or Application.Match instead but had the same issue... I wonder if there is a VBA function I don't know about? Or maybe someone has an idea for a custom function or an entirely different approach? I've hit a brick wall...
Thank you in advance for any advice! I highly appreciate it.
Unfortunately I can't show you the data since it's customer's sensitive data but here's my loop:
With ActiveWorkbook
For p = 1 To size
For j = 6 To lrow
a = .Sheets("Server View").Cells(j, 3).Value
tmp = Apps(p)
test = InStr(1, a, tmp)
If test = 0 Then
Else
b = .Sheets("Server View").Cells(j, 9).Value
If b = PROD Then
cval = .Sheets("temp").Cells(j, 3).Value
cval = cval + 1
.Sheets("temp").Cells(j, 3).Value = cval
Else
cval = .Sheets("temp").Cells(j, 2).Value
cval = cval + 1
.Sheets("temp").Cells(j, 2).Value = cval
End If
End If
Next j
Next p
End With
I'm trying to compare strings in a macro and the data isn't always entered consistently. The difference comes down to the amount of leading white space (ie " test" vs. "test" vs. " test")
For my macro the three strings in the example should be equivalent. However I can't use Replace, as any spaces in the middle of the string (ex. "test one two three") should be retained. I had thought that was what Trim was supposed to do (as well as removing all trailing spaces). But when I use Trim on the strings, I don't see a difference, and I'm definitely left with white space at the front of the string.
So A) What does Trim really do in VBA? B) Is there a built in function for what I'm trying to do, or will I just need to write a function?
Thanks!
So as Gary's Student aluded to, the character wasn't 32. It was in fact 160. Now me being the simple man I am, white space is white space. So in line with that view I created the following function that will remove ALL Unicode characters that don't actual display to the human eye (i.e. non-special character, non-alphanumeric). That function is below:
Function TrueTrim(v As String) As String
Dim out As String
Dim bad As String
bad = "||127||129||141||143||144||160||173||" 'Characters that don't output something
'the human eye can see based on http://www.gtwiki.org/mwiki/?title=VB_Chr_Values
out = v
'Chop off the first character so long as it's white space
If v <> "" Then
Do While AscW(Left(out, 1)) < 33 Or InStr(1, bad, "||" & AscW(Left(out, 1)) & "||") <> 0 'Left(out, 1) = " " Or Left(out, 1) = Chr(9) Or Left(out, 1) = Chr(160)
out = Right(out, Len(out) - 1)
Loop
'Chop off the last character so long as it's white space
Do While AscW(Right(out, 1)) < 33 Or InStr(1, bad, "||" & AscW(Right(out, 1)) & "||") <> 0 'Right(out, 1) = " " Or Right(out, 1) = Chr(9) Or Right(out, 1) = Chr(160)
out = Left(out, Len(out) - 1)
Loop
End If 'else out = "" and there's no processing to be done
'Capture result for return
TrueTrim = out
End Function
TRIM() will remove all leading spaces
Sub demo()
Dim s As String
s = " test "
s2 = Trim(s)
msg = ""
For i = 1 To Len(s2)
msg = msg & i & vbTab & Mid(s2, i, 1) & vbCrLf
Next i
MsgBox msg
End Sub
It is possible your data has characters that are not visible, but are not spaces either.
Without seeing your code it is hard to know, but you could also use the Application.WorksheetFunction.Clean() method in conjunction with the Trim() method which removes non-printable characters.
MSDN Reference page for WorksheetFunction.Clean()
Why don't you try using the Instr function instead? Something like this
Function Comp2Strings(str1 As String, str2 As String) As Boolean
If InStr(str1, str2) <> 0 Or InStr(str2, str1) <> 0 Then
Comp2Strings = True
Else
Comp2Strings = False
End If
End Function
Basically you are checking if string1 contains string2 or string2 contains string1. This will always work, and you dont have to trim the data.
VBA's Trim function is limited to dealing with spaces. It will remove spaces at the start and end of your string.
In order to deal with things like newlines and tabs, I've always imported the Microsoft VBScript RegEx library and used it to replace whitespace characters.
In your VBA window, go to Tools, References, the find Microsoft VBScript Regular Expressions 5.5. Check it and hit OK.
Then you can create a fairly simple function to trim all white space, not just spaces.
Private Function TrimEx(stringToClean As String)
Dim re As New RegExp
' Matches any whitespace at start of string
re.Pattern = "^\s*"
stringToClean = re.Replace(stringToClean, "")
' Matches any whitespace at end of string
re.Pattern = "\s*$"
stringToClean = re.Replace(stringToClean, "")
TrimEx = stringToClean
End Function
Non-printables divide different lines of a Web page. I replaced them with X, Y and Z respectively.
Debug.Print Trim(Mid("X test ", 2)) ' first place counts as 2 in VBA
Debug.Print Trim(Mid("XY test ", 3)) ' second place counts as 3 in VBA
Debug.Print Trim(Mid("X Y Z test ", 2)) ' more rounds needed :)
Programmers prefer large text as may neatly be chopped with built in tools (inSTR, Mid, Left, and others). Use of text from several children (i.e taking .textContent versus .innerText) may result several non-printables to cope with, yet DOM and REGEX are not for beginners. Addressing sub-elements for inner text precisely (child elements one-by-one !) may help evading non-printable characters.
I'm trying to figure out a way to extract the last alpha+numeric sequence in a string made up of similar patterns. The sequence is an alpha+numeric pair: an alpha string (one or more letters) plus a numeric string (one or more numbers). For instance:
G98Y8RT9 -- I need to isolate "RT9"
H8L77 -- I need to isolate "L77"
D64RL19HT7899 -- I need to isolate "HT7899"
As shown above, there are a variable number of characters in each part of the pair and also in the number of pairs preceding the last one. I've tried Excel formulas using FIND, ISNUMBER, etc., but I couldn't figure out the logic to make it work for these variables.
Is there a formula that would help? Or is some kind of regex VBA function the way to go?
I think this should work, as a user-defined function you can place it in a standard module, and call it like:
=GetLastPair($A$1), etc.
Here is the function:
Function GetLastPair(str As String)
Dim numPart As Integer
Dim strPart As Integer
Do Until Not IsNumeric(Mid(str, Len(str) - numPart, 1))
numPart = numPart + 1
Loop
Do Until IsNumeric(Mid(str, Len(str) - numPart - strPart, 1))
strPart = strPart + 1
Loop
GetLastPair = Right(str, numPart + strPart)
End Function
Results:
A bit long formula, but seems to work:
=RIGHT(A1,MATCH(TRUE,ISNUMBER(1*MID(A1,LEN(A1)-MATCH(FALSE,ISNUMBER(1*MID(A1,LEN(A1)-{0,1,2,3,4,5,6,7,8},1)),0)-{0,1,2,3,4,5,6,7,8},1)),0)+MATCH(FALSE,ISNUMBER(1*MID(A1,LEN(A1)-{0,1,2,3,4,5,6,7,8},1)),0)-1)