I wrote a function for calc to split a cell before a word containing certain characters:
Function sidx(inputstr) As Integer
Dim newString As String
newString = ""
Dim last_space_idx As String
last_space_idx = 0
Dim l As Integer
'l = (inputstr.Length - 1) was ported from js on google sheets
l = Len(inputstr) - 1
For i = 0 To l
If inputstr(i) = " " Then
last_space_idx = i
End If
If ("’aeiou".Indexof( inputstr(i) ) > 0) Then
sidx = last_space_idx
End If
Next i
sidx = last_space_idx
End Function
for some reason libreoffice has trouble parsing this and complains about mismatched parenthesis or missing Then at the last If statement. Any ideas?
So thanks everyone for all the help - there are many pitfalls porting javascript to libreoffice vba and the interpreter is not that useful... You spotting most of the issues!
Letter extraction was also broken and as I originally believed the brackets was not the real issue!
For closure here is the working version
Function sidx (inputstr As String) As Integer
Dim newString as String
newString = ""
Dim last_space_idx as String
last_space_idx = 0
Dim l as Integer
l = Len(inputstr) -1
For i = 0 to l
letter = Mid(cstr(inputstr),i+1,1)
If letter = " " Then
last_space_idx = i
End If
'If ("’āēīōū".Indexof(inputstr(i))) > 0 Then
If InStr("\’āēīōū",letter) > 0 Then
sidx = last_space_idx
End If
Next i
sidx = last_space_idx
End Function
Related
I am writing a VBA code to add +2 to any string of numbers that are put in the function.
It works fine, until it reaches 6 and 7, then it breaks. I really have no clue why that is.
If you are wondering why I am doing this, this is part of an encryption algorithm and it is specifically looking to encrypt digits in a string.
My code is:
Sub AddNumbers()
Dim Nos As String
Dim AddNo As String
Dim Found As Boolean
Dim Split()
Nos = "0-1-2-3-4-5-6-7-8-9-10"
Sheets("Sheet1").Range("U2").Value = Nos
Length = Len(Nos)
ReDim Split(Length)
For i = 1 To Length
Found = False
Split(i) = Mid(Nos, i, 1)
For O = 48 To 55
If Split(i) = Chr(O) Then
Split(i) = Chr(O + 2)
Found = True
Exit For
End If
Next O
If Split(i) = Chr(56) Then
Split(i) = Chr(48)
ElseIf Split(i) = Chr(57) Then
Split(i) = Chr(49)
End If
Next i
AddNo = Join(Split, "")
Sheets("Sheet1").Range("U3").Value = AddNo
End Sub
I would really appreciate an insight to why it is breaking at 6 and 7.
Take me a moment, but you are double adding.
Look at your loop. When you encounter 6 (Char(54)) you add 2 and have 8 (Char(56)).
But then, after your loop you are testing again for same Split(i). Char for 6 and 7 are now accordingly 56 and 57 - so you add another 2 to them.
If Split(i) = Chr(56) And Found = False Then
Split(i) = Chr(48)
ElseIf Split(i) = Chr(57) And Found = False Then
Split(i) = Chr(49)
End If
Use the actual function Split:
Sub AddNumbers()
Dim Nos As String
Dim AddNo As String
Dim Found As Boolean
Dim SplitStr() As String
Nos = "0-1-2-3-4-5-6-7-8-9-10"
Sheets("Sheet1").Range("U2").Value = Nos
SplitStr = Split(Nos, "-")
Dim i As Long
For i = LBound(SplitStr) To UBound(SplitStr)
Dim vlue As String
vlue = StrConv(SplitStr(i), vbUnicode)
Dim substr() As String
substr = Split(Left(vlue, Len(vlue) - 1), vbNullChar)
Dim j As Long
For j = LBound(substr) To UBound(substr)
Select Case substr(j)
Case 8
substr(j) = 0
Case 9
substr(j) = 1
Case Else
substr(j) = substr(j) + 2
End Select
Next j
SplitStr(i) = Join(substr, "")
Next i
AddNo = Join(SplitStr, "-")
Sheets("Sheet1").Range("U3").Value = AddNo
End Sub
The overall problem is that you are using the Chr codes for numbers and not actual numbers. This method only returns 1 digit because a Chr() refers to a list of single characters.
You are going to need to use Split (mySplit = Split(Nos,"-")) to return each number and work with those.
The lines
If Split(i) = Chr(56) Then
Split(i) = Chr(48)
ElseIf Split(i) = Chr(57) Then
Split(i) = Chr(49)
End If
has me confused. You are saying if the value is "8" change to "0" and if it is "9" change to "1"
This is another way to do it:
Sub AddNumbers()
Dim Nos As String, Nos2 As String
Dim NumSplit As Variant
Dim Num As Variant
Dim tmp As String
Dim i As Long
Nos = "0-1-2-3-4-5-6-7-8-9-10"
Sheets("Sheet1").Range("U2").Value = Nos
NumSplit = Split(Nos, "-")
For Each Num In NumSplit
For i = 1 To Len(Num)
tmp = tmp & Mid(Num, i, 1) + 2
Next i
Nos2 = Nos2 & tmp & "-"
tmp = ""
Next Num
Nos2 = Left(Nos2, Len(Nos2) - 1)
Sheets("Sheet1").Range("U3").Value = Nos2
End Sub
It's a bit messy, but shows the basic idea of splitting the original array into the separate numbers.
The For....Next loop inside the For...Each loop takes care of any numbers with more than one digit (giving the 32).
The following code splits each lines into words and store the first words in each line into array list and the second words into another array list and so on. Then it selects the most frequent word from each list as correct word.
Module Module1
Sub Main()
Dim correctLine As String = ""
Dim line1 As String = "Canda has more than ones official language"
Dim line2 As String = "Canada has more than one oficial languages"
Dim line3 As String = "Canada has nore than one official lnguage"
Dim line4 As String = "Canada has nore than one offical language"
Dim wordsOfLine1() As String = line1.Split(" ")
Dim wordsOfLine2() As String = line2.Split(" ")
Dim wordsOfLine3() As String = line3.Split(" ")
Dim wordsOfLine4() As String = line4.Split(" ")
For i As Integer = 0 To wordsOfLine1.Length - 1
Dim wordAllLinesTemp As New List(Of String)(New String() {wordsOfLine1(i), wordsOfLine2(i), wordsOfLine3(i), wordsOfLine4(i)})
Dim counts = From n In wordAllLinesTemp
Group n By n Into Group
Order By Group.Count() Descending
Select Group.First
correctLine = correctLine & counts.First & " "
Next
correctLine = correctLine.Remove(correctLine.Length - 1)
Console.WriteLine(correctLine)
Console.ReadKey()
End Sub
End Module
My Question: How can I make it works with lines of different number of words. I mean that the length of each lines here is 7 words and the for loop works with this length (length-1). Suppose that line 3 contains 5 words.
EDIT: Accidentally had correctIndex where shortest should have been.
From what I can tell you are trying to see which line is the closest to the correctLine.
You can get the levenshtein distance using the following code:
Public Function LevDist(ByVal s As String,
ByVal t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim d(n + 1, m + 1) As Integer
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
Dim i As Integer
Dim j As Integer
For i = 0 To n
d(i, 0) = i
Next
For j = 0 To m
d(0, j) = j
Next
For i = 1 To n
For j = 1 To m
Dim cost As Integer
If t(j - 1) = s(i - 1) Then
cost = 0
Else
cost = 1
End If
d(i, j) = Math.Min(Math.Min(d(i - 1, j) + 1, d(i, j - 1) + 1),
d(i - 1, j - 1) + cost)
Next
Next
Return d(n, m)
End Function
And then, this would be used to figure out which line is closest:
Dim correctLine As String = ""
Dim line1 As String = "Canda has more than ones official language"
Dim line2 As String = "Canada has more than one oficial languages"
Dim line3 As String = "Canada has nore than one official lnguage"
Dim line4 As String = "Canada has nore than one offical language"
Dim lineArray As new ArrayList
Dim countArray As new ArrayList
lineArray.Add(line1)
lineArray.Add(line2)
lineArray.Add(line3)
lineArray.Add(line4)
For i = 0 To lineArray.Count - 1
countArray.Add(LevDist(lineArray(i), correctLine))
Next
Dim shortest As Integer = Integer.MaxValue
Dim correctIndex As Integer = 0
For i = 0 To countArray.Count - 1
If countArray(i) <= shortest Then
correctIndex = i
shortest = countArray(i)
End If
Next
Console.WriteLine(lineArray(correctIndex))
I am developing a program where you can input a sentence and then search for a word. The program will then tell you at which positions this word occurs. I have written some code but do not know how to continue.
Module Module1
Sub Main()
Dim Sentence As String
Dim SentenceLength As Integer
Dim L As Integer = 0
Dim LotsofText As String = Console.ReadLine
Console.WriteLine("Enter your word ") : Sentence = Console.ReadLine
For L = 1 To LotsofText.Length
If (Mid(LotsofText, L, 1)) = " " Then
End If
L = L + 1
Dim TextCounter As Integer = 0
Dim MainWord As String = Sentence
Dim CountChar As String = " "
Do While InStr(MainWord, CountChar) > 0
MainWord = Mid(MainWord, 1 + InStr(MainWord, CountChar), Len(MainWord))
TextCounter = TextCounter + 1
'Text = TextCounter + 2
' Console.WriteLine(Text)
Loop
Console.WriteLine(TextCounter)
Console.Write("Press Enter to Exit")
Console.ReadLine()
End Sub
End Module
Transform this piece of code from C# to Visual Basic. match.Index will indicate the position of the given word.
var rx = new Regex("your");
foreach (Match match in rx.Matches("This is your text! This is your text!"))
{
int i = match.Index;
}
To find only words and not sub-strings (for example to ignore "cat" in "catty"):
Dim LotsofText = "catty cat"
Dim Sentence = "cat"
Dim pattern = "\b" & Regex.Escape(Sentence) & "\b"
Dim matches = Regex.Matches(LotsofText, pattern)
For Each m As Match In matches
Debug.Print(m.Index & "") ' 6
Next
If you want to find sub-strings too, you can remove the "\b" parts.
If you add this function to your code:
Public Function GetIndexes(ByVal SearchWithinThis As String, ByVal SearchForThis As String) As List(Of Integer)
Dim Result As New List(Of Integer)
Dim i As Integer = SearchWithinThis.IndexOf(SearchForThis)
While (i <> -1)
Result.Add(i)
i = SearchWithinThis.IndexOf(SearchForThis, i + 1)
End While
Return Result
End Function
And call the function in your code:
Dim Indexes as list(of Integer) = GetIndexes(LotsofText, Sentence)
Now GetIndexes will find all indexes of the word you are searching for within the sentence and put them in the list Indexes.
All,
I have an Excel spreadsheet which gathers files from various locations which have version numbers at the end of their name.
eg
Filea_v1.1.xlsm
Filea_v1.1.1.xlsm
Filea_v9.1.xlsm
Filea_v11.1.1.xlsm
I have already stripped the details of the file and left with the version number, but I'm finding it hard to code to get the latest version. When using a simple
If LatestVersion > LatestVersion_Last
' 11.1.1 > 9.1
I get a FALSE output as it thinks the 9.1 is greater than 11.1.1 (as its held in a string). I can't convert to a number that I'm aware of as it contains more than one decimal place.
Does anyone have any suggestions?
Thanks
This function returns 1 if the version of the first input string is bigger, -1 if the second one is bigger and 0 if both are equal:
Function Compare(a As String, b As String) As Integer
Dim n As Integer
Dim aarr() As String
Dim barr() As String
Dim av As Integer
Dim bv As Integer
aarr = Split(a, ".")
barr = Split(b, ".")
n = LBound(aarr)
Do
av = -1
If UBound(aarr) > i - 1 Then av = CInt(aarr(i))
bv = -1
If UBound(barr) > i - 1 Then bv = CInt(barr(i))
If av = -1 And bv = -1 Then
Compare = 0
Exit Function
End If
If av > bv Then
Compare = 1
Exit Function
End If
If av < bv Then
Compare = -1
Exit Function
End If
i = i + 1
Loop
End Function
Public Fucntion CompareVersion( strVersion1 as String, strVersion2 as String)
strVersion1 = "Filea_v11.1.1.xlsm"
strVersion2 = "Filea_v9.1.xlsm"
strVersion1 = Replace(strVersion1, "Filea_v", "") 'remove prefix
strVersion1 = Replace(strVersion1, ".xlsm", "") ' remove suffix
strVersion1 = Replace(strVersion1, ".", "") 'remove dots
strVersion2 = Replace(strVersion1, "Filea_v", "") 'remove prefix
strVersion2 = Replace(strVersion1, ".xlsm", "") ' remove suffix
strVersion2 = Replace(strVersion1, ".", "") 'remove dots
Dim strVersionArray1 as String()
Dim strVersionArray2 as String()
strVersionArray1 = Split(strVersion1,".")
strVersionArray2 = Split(strVersion2,".")
Dim i as Integer
For i=LBound(strVersionArray1) To UBound(strVersionArray2)
If (Cint(strVersionArray1(i))>Cint(strVersionArray2(i))) Then
'strVerion1 is greater than strVersion2
GoTo EXIT_FUNC:
Else If (Cint(strVersionArray1(i))<Cint(strVersionArray2(i))) Then
'strVerion is greater than strVersion2
GoTo EXIT_FUNC:
Else If (Cint(strVersionArray1(i))=Cint(strVersionArray2(i))) Then
'we need to examine the next segment of the array
End if
Next i
EXIT_FUNC:
End Function
I think you could try something like this:
Function FctLatest(ByVal LatestVersion As String, ByVal LatestVersion_Last As String) As Boolean
Dim comparedNew, comparedOld As String
'Loop to remove the versions one by one
Do
'For the new version
comparedNew = CutString(comparedNew, LatestVersion)
'For the previous version
comparedOld = CutString(comparedOld, LatestVersion_Last)
'we eliminate the case of equal versions
If CInt(comparedNew) > CInt(comparedOld) Then
FctLatest = True
GoTo endFunction
ElseIf CInt(comparedNew) < CInt(comparedOld) Then
FctLatest = False
GoTo endFunction
End If
Loop While InStr(LatestVersion_Last, ".") <> 0 Or InStr(LatestVersion, ".") <> 0
'For the new version
comparedNew = CutString(comparedNew, LatestVersion)
'For the previous version
comparedOld = CutString(comparedOld, LatestVersion_Last)
'we eliminate the case of equal versions, and choose the first one input
If CInt(comparedNew) > CInt(comparedOld) Then
FctLatest = True
ElseIf CInt(comparedNew) < CInt(comparedOld) Then
FctLatest = False
End If
endFunction:
End Function
Private Function CutString(ByVal ReturnedString, ByRef InputString As String) As String
'For latest version
If InStr(InputString, ".") = 0 Then
ReturnedString = InputString
Else
ReturnedString = Left(InputString, InStr(InputString, ".") - 1) 'Adding the first part of the version
InputString = Right(InputString, Len(InputString) - InStr(InputString, ".")) 'Removing the first part of the version
End If
CutString = ReturnedString
End Function
It returns a boolean comparing the versions you're interested in.
Regards,
Pierre.
Edit: just added cases, as it wasn't functional in the first place.
I have string "ololo123".
I need get position of first digit - 1.
How to set mask of search ?
Here is a lightweight and fast method that avoids regex/reference additions, thus helping with overhead and transportability should that be an advantage.
Public Function GetNumLoc(xValue As String) As Integer
For GetNumLoc = 1 To Len(xValue)
If Mid(xValue, GetNumLoc, 1) Like "#" Then Exit Function
Next
GetNumLoc = 0
End Function
Something like this should do the trick for you:
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
You can then call it like this:
Dim iPosition as Integer
iPosition = GetPositionOfFirstNumericCharacter("ololo123")
Not sure on your environment, but this worked in Excel 2010
'Added reference for Microsoft VBScript Regular Expressions 5.5
Const myString As String = "ololo123"
Dim regex As New RegExp
Dim regmatch As MatchCollection
regex.Pattern = "\d"
Set regmatch = regex.Execute(myString)
MsgBox (regmatch.Item(0).FirstIndex) ' Outputs 5
I actually have that function:
Public Function GetNumericPosition(ByVal s As String) As Integer
Dim result As Integer
Dim i As Integer
Dim ii As Integer
result = -1
ii = Len(s)
For i = 1 To ii
If IsNumeric(Mid$(s, i, 1)) Then
result = i
Exit For
End If
Next
GetNumericPosition = result
End Function
You could try regex, and then you'd have two problems. My VBAfu is not up to snuff, but I'll give it a go:
Function FirstDigit(strData As String) As Integer
Dim RE As Object REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "[0-9]"
End With
Set REMatches = RE.Execute(strData)
FirstDigit = REMatches(0).FirstIndex
End Function
Then you just call it with FirstDigit("ololo123").
If speed is an issue, this will run a bit faster than Robs (noi Rob):
Public Sub Example()
Const myString As String = "ololo123"
Dim position As Long
position = GetFirstNumeric(myString)
If position > 0 Then
MsgBox "Found numeric at postion " & position & "."
Else
MsgBox "Numeric not found."
End If
End Sub
Public Function GetFirstNumeric(ByVal value As String) As Long
Dim i As Long
Dim bytValue() As Byte
Dim lngRtnVal As Long
bytValue = value
For i = 0 To UBound(bytValue) Step 2
Select Case bytValue(i)
Case vbKey0 To vbKey9
If bytValue(i + 1) = 0 Then
lngRtnVal = (i \ 2) + 1
Exit For
End If
End Select
Next
GetFirstNumeric = lngRtnVal
End Function
An improved version of spere's answer (can't edit his answer), which works for any pattern
Private Function GetNumLoc(textValue As String, pattern As String) As Integer
For GetNumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, GetNumLoc, Len(pattern)) Like pattern Then Exit Function
Next
GetNumLoc = 0
End Function
To get the pattern value you can use this:
Private Function GetTextByPattern(textValue As String, pattern As String) As String
Dim NumLoc As Integer
For NumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, NumLoc, Len(pattern)) Like pattern Then
GetTextByPattern = Mid(textValue, NumLoc, Len(pattern))
Exit Function
End If
Next
GetTextByPattern = ""
End Function
Example use:
dim bill as String
bill = "BILLNUMBER 2202/1132/1 PT2200136"
Debug.Print GetNumLoc(bill , "PT#######")
'Printed result:
'24
Debug.Print GetTextByPattern(bill , "PT#######")
'Printed result:
'PT2200136