Meni je trebalo
Code:
Sub example_of_parsing()
'* This is an example of how to parse a sentence into individual words.
'* Press F5 to run this code
Dim i As Integer
Dim s As String
Dim sWord As String
i = 1
s = "This is the new house next door." '<< Put the sentence here.
sWord = xg_GetSubString(s, i, " ")
Do While sWord <> ""
MsgBox sWord
i = i + 1
sWord = xg_GetSubString(s, i, " ")
Loop
End Sub
Sub examples()
'* Example of the functions in this module
'*
'* To test the functions, un-comment the line, and click the go/continue button (or press f5)
Dim MyField As String
MyField = "123456789"
'MsgBox xg_GetWordsBetween("The Lazy Fox", "The", "Fox")
'MsgBox xg_GetLastWord("The Lazy Fox") '* Get last word in sentence
'MsgBox xg_GetSubString("The Lazy Fox", 2, " ") '* Get second substring, " " is delimiter
'MsgBox xg_GetSubString("a;b;c;d;e;f;g;h", 4, ";") '* Get 4th substring, ";" is delimiter
'MsgBox xg_ReplaceAllWith("The Lazy Fox is crazed", "az", "onel") '* Replace "az" with "onel"
'MsgBox xg_lPad(MyField, "0", 10) '* Left pad with 0 to length of 10 chars
'MsgBox xg_RPad(MyField, "x", 12) '* Right pad with "x" to length of 12 chars
End Sub
Function xg_lPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
'* Pads characters on the left of a string out to a desired total string length
'* Returns the padded string
xg_lPad = xg_Repeat(sPadChar, iTotalDesiredLengthOfString - Len(Trim(sStringToPad))) & Trim(sStringToPad)
End Function
Function xg_RPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
Dim i As Integer
Dim sFill As String
sFill = ""
If Len(sStringToPad) < iTotalDesiredLengthOfString Then
For i = 1 To (iTotalDesiredLengthOfString - Len(sStringToPad))
sFill = sFill & sPadChar
Next i
End If
xg_RPad = sStringToPad & sFill
End Function
Function xg_Repeat(sStringToRepeat As String, iNumOfTimes As Integer) As String
Dim i As Integer
Dim s As String
s = ""
For i = 1 To iNumOfTimes
s = s & sStringToRepeat
Next i
xg_Repeat = s
End Function
Function xg_ReplaceAllWith(sMainString As String, sSubString As String, sReplaceString As String) As String
'* Recursive function to replace all occurences of sSubString
'* with sReplaceString in sMainString
Dim i As Integer
Dim ipos As Integer
Dim s As String
Dim s1 As String, s2 As String
s = sMainString
ipos = InStr(1, sMainString, sSubString)
If ipos = 0 Then
GoTo Exit_xg_ReplaceAllWith
End If
s1 = Mid(sMainString, 1, ipos - 1)
s2 = Mid(sMainString, ipos + Len(sSubString), Len(sMainString))
s = s1 & sReplaceString & xg_ReplaceAllWith(s2, sSubString, sReplaceString)
Exit_xg_ReplaceAllWith:
xg_ReplaceAllWith = s
End Function
Function xg_GetWordsBetween(sMain As String, s1 As String, s2 As String) As String
'* Returns a trimmed substring of the string 'sMain' that lies between substrings s1 and s2
'* Ex.: xg_GetWordsBetween("The Lazy Fox", "The", "Fox") returns "Lazy".
On Error Resume Next
Dim iStart As Integer, iEnd As Integer
iStart = InStr(1, sMain, s1) + Len(s1)
iEnd = InStr(iStart, sMain, s2)
xg_GetWordsBetween = Trim(Mid(sMain, iStart, iEnd - iStart))
End Function
Function xg_GetLastWord(sStr As String) As String
'* Returns the last word in sStr
Dim i As Integer
Dim ilen As Integer
Dim s As String
Dim stemp As String
Dim sLastWord As String
Dim sHold As String
Dim iFoundChar As Integer
stemp = ""
sLastWord = ""
iFoundChar = False
sHold = sStr
ilen = Len(sStr)
For i = ilen To 1 Step -1
s = right(sHold, 1)
If s = " " Then
If Not iFoundChar Then
'* skip spaces at end of string.
Else
sLastWord = stemp
Exit For
End If
Else
iFoundChar = True
stemp = s & stemp
End If
If Len(sHold) > 0 Then
sHold = left(sHold, Len(sHold) - 1)
End If
Next i
If sLastWord = "" And stemp <> "" Then
sLastWord = stemp
End If
'MsgBox "lastword =" & Trim(sLastWord)
xg_GetLastWord = Trim(sLastWord)
End Function
Function xg_GetSubString(mainstr As String, n As Integer, delimiter As String) As String
'* Get the "n"-th substring from "mainstr" where strings are delimited by "delimiter"
Dim i As Integer
Dim substringcount As Integer
Dim pos As Integer
Dim strx As String
Dim val1 As Integer
Dim w As String
On Error GoTo Err_xg_GetSubString
w = ""
substringcount = 0
i = 1
pos = InStr(i, mainstr, delimiter)
Do While pos <> 0
strx = Mid(mainstr, i, pos - i)
substringcount = substringcount + 1
If substringcount = n Then
Exit Do
End If
i = pos + 1
pos = InStr(i, mainstr, delimiter)
Loop
If substringcount = n Then
xg_GetSubString = strx
Else
strx = Mid(mainstr, i, Len(mainstr) + 1 - i)
substringcount = substringcount + 1
If substringcount = n Then
xg_GetSubString = strx
Else
xg_GetSubString = ""
End If
End If
Exit Function
Err_xg_GetSubString:
MsgBox "xg_GetSubString " & err & " " & err.Description
Resume Next
End Function
Sub example_of_parsing()
'* This is an example of how to parse a sentence into individual words.
'* Press F5 to run this code
Dim i As Integer
Dim s As String
Dim sWord As String
i = 1
s = "This is the new house next door." '<< Put the sentence here.
sWord = xg_GetSubString(s, i, " ")
Do While sWord <> ""
MsgBox sWord
i = i + 1
sWord = xg_GetSubString(s, i, " ")
Loop
End Sub
Sub examples()
'* Example of the functions in this module
'*
'* To test the functions, un-comment the line, and click the go/continue button (or press f5)
Dim MyField As String
MyField = "123456789"
'MsgBox xg_GetWordsBetween("The Lazy Fox", "The", "Fox")
'MsgBox xg_GetLastWord("The Lazy Fox") '* Get last word in sentence
'MsgBox xg_GetSubString("The Lazy Fox", 2, " ") '* Get second substring, " " is delimiter
'MsgBox xg_GetSubString("a;b;c;d;e;f;g;h", 4, ";") '* Get 4th substring, ";" is delimiter
'MsgBox xg_ReplaceAllWith("The Lazy Fox is crazed", "az", "onel") '* Replace "az" with "onel"
'MsgBox xg_lPad(MyField, "0", 10) '* Left pad with 0 to length of 10 chars
'MsgBox xg_RPad(MyField, "x", 12) '* Right pad with "x" to length of 12 chars
End Sub
Function xg_lPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
'* Pads characters on the left of a string out to a desired total string length
'* Returns the padded string
xg_lPad = xg_Repeat(sPadChar, iTotalDesiredLengthOfString - Len(Trim(sStringToPad))) & Trim(sStringToPad)
End Function
Function xg_RPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
Dim i As Integer
Dim sFill As String
sFill = ""
If Len(sStringToPad) < iTotalDesiredLengthOfString Then
For i = 1 To (iTotalDesiredLengthOfString - Len(sStringToPad))
sFill = sFill & sPadChar
Next i
End If
xg_RPad = sStringToPad & sFill
End Function
Function xg_Repeat(sStringToRepeat As String, iNumOfTimes As Integer) As String
Dim i As Integer
Dim s As String
s = ""
For i = 1 To iNumOfTimes
s = s & sStringToRepeat
Next i
xg_Repeat = s
End Function
Function xg_ReplaceAllWith(sMainString As String, sSubString As String, sReplaceString As String) As String
'* Recursive function to replace all occurences of sSubString
'* with sReplaceString in sMainString
Dim i As Integer
Dim ipos As Integer
Dim s As String
Dim s1 As String, s2 As String
s = sMainString
ipos = InStr(1, sMainString, sSubString)
If ipos = 0 Then
GoTo Exit_xg_ReplaceAllWith
End If
s1 = Mid(sMainString, 1, ipos - 1)
s2 = Mid(sMainString, ipos + Len(sSubString), Len(sMainString))
s = s1 & sReplaceString & xg_ReplaceAllWith(s2, sSubString, sReplaceString)
Exit_xg_ReplaceAllWith:
xg_ReplaceAllWith = s
End Function
Function xg_GetWordsBetween(sMain As String, s1 As String, s2 As String) As String
'* Returns a trimmed substring of the string 'sMain' that lies between substrings s1 and s2
'* Ex.: xg_GetWordsBetween("The Lazy Fox", "The", "Fox") returns "Lazy".
On Error Resume Next
Dim iStart As Integer, iEnd As Integer
iStart = InStr(1, sMain, s1) + Len(s1)
iEnd = InStr(iStart, sMain, s2)
xg_GetWordsBetween = Trim(Mid(sMain, iStart, iEnd - iStart))
End Function
Function xg_GetLastWord(sStr As String) As String
'* Returns the last word in sStr
Dim i As Integer
Dim ilen As Integer
Dim s As String
Dim stemp As String
Dim sLastWord As String
Dim sHold As String
Dim iFoundChar As Integer
stemp = ""
sLastWord = ""
iFoundChar = False
sHold = sStr
ilen = Len(sStr)
For i = ilen To 1 Step -1
s = right(sHold, 1)
If s = " " Then
If Not iFoundChar Then
'* skip spaces at end of string.
Else
sLastWord = stemp
Exit For
End If
Else
iFoundChar = True
stemp = s & stemp
End If
If Len(sHold) > 0 Then
sHold = left(sHold, Len(sHold) - 1)
End If
Next i
If sLastWord = "" And stemp <> "" Then
sLastWord = stemp
End If
'MsgBox "lastword =" & Trim(sLastWord)
xg_GetLastWord = Trim(sLastWord)
End Function
Function xg_GetSubString(mainstr As String, n As Integer, delimiter As String) As String
'* Get the "n"-th substring from "mainstr" where strings are delimited by "delimiter"
Dim i As Integer
Dim substringcount As Integer
Dim pos As Integer
Dim strx As String
Dim val1 As Integer
Dim w As String
On Error GoTo Err_xg_GetSubString
w = ""
substringcount = 0
i = 1
pos = InStr(i, mainstr, delimiter)
Do While pos <> 0
strx = Mid(mainstr, i, pos - i)
substringcount = substringcount + 1
If substringcount = n Then
Exit Do
End If
i = pos + 1
pos = InStr(i, mainstr, delimiter)
Loop
If substringcount = n Then
xg_GetSubString = strx
Else
strx = Mid(mainstr, i, Len(mainstr) + 1 - i)
substringcount = substringcount + 1
If substringcount = n Then
xg_GetSubString = strx
Else
xg_GetSubString = ""
End If
End If
Exit Function
Err_xg_GetSubString:
MsgBox "xg_GetSubString " & err & " " & err.Description
Resume Next
End Function