[ emol @ 03.09.2010. 20:06 ] @
Malo prije našao pa ako nekom treba .... 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 |