|
| | | |
 • II.4. VBA - Obróbka tekstu [1] •
- 4.1 Jak przekonwertować ciąg znaków do tablicy typu Byte oraz jak przekonwertować tablicę typu Byte na ciąg znaków ?
- 4.2 Jak pobrać ilość wystąpień znaku (sekwencji znaków) w wejściowym ciągu znaków ?
- 4.3 Jak pobrać do tablicy (0 To 255) ilość wystąpień wszystkich pojedynczych znaków występujących w ciągu wejściowym ?
- 4.4 Dlaczego w Access'ie 97 nie działa funkcja Split ?
- 4.5 Dlaczego w Access'ie 97 nie działa funkcja Join ?
- 4.6 Dlaczego w Access'ie 97 nie działa funkcja Replace ?
- 4.7 Dlaczego w Access'ie 97 nie działa funkcja StrReverse ?
- 4.8 Dlaczego w Access'ie 97 nie działa funkcja InStrRev ?
- 4.9 Jak rozpoznać, czy tekst jest pisany w całości dużymi lub małymi literami ?
- <• idź do str. 2 •>
<• idź do str. 3 •>
| | | | |
 |
| | |
|
4.1 Jak przekonwertować ciąg znaków do tablicy typu Byte oraz jak przekonwertować tablicę typu Byte na ciąg znaków?
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub btnTest_Click()
Dim arrCopyMem() As Byte
Dim arrStrConv() As Byte
Dim sStrOut As String
Dim lLen As Long
Dim i As Long
Const MY_STRING As String = _
"Ala ma Asa, a Ola ma gżegżółkę !"
Debug.Print "Metoda: CopyMemory(...)"
' konwertuj ciąg znaków do tablicy bajtów
lLen = Len(MY_STRING)
ReDim arrCopyMem(0 To lLen - 1)
CopyMemory arrCopyMem(0), ByVal MY_STRING, lLen
For i = 0 To UBound(arrCopyMem)
Debug.Print (arrCopyMem(i));
Next
Debug.Print: Debug.Print "Metoda: StrConv(...)"
' lub prościej, trochę szybciej i bez API
arrStrConv = StrConv(MY_STRING, vbFromUnicode)
For i = 0 To UBound(arrStrConv)
Debug.Print (arrStrConv(i));
Next
Debug.Print
' konwertuj tablicę bajtów na ciąg znaków
lLen = UBound(arrCopyMem) + 1
sStrOut = String(lLen, vbNullChar)
CopyMemory ByVal sStrOut, arrCopyMem(0), lLen
Debug.Print "Metoda: CopyMemory(...)", sStrOut
' lub prościej, trochę szybciej i bez API
sStrOut = ""
sStrOut = StrConv(arrStrConv, vbUnicode)
Debug.Print "Metoda: StrConv(...)", sStrOut
DoCmd.RunCommand acCmdDebugWindow
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.2 Jak pobrać ilość wystąpień znaku (sekwencji znaków) w wejściowym ciągu znaków ?
' zwraca ilość wystąpień ciągu znaków sMatch w ciągu wejściowym,
' • sStrIn - ciąg wejściowy, jeżeli jest ciągiem zerowej długości, funkcja zwraca -1,
' • sMatch - szukany ciąg znaków, jeżeli jest ciągiem zerowej długości, funkcja zwraca -1,
' • lCompare - określa sposób porównywania ciągów,
Public Function zbCountInString( _
sStrIn As String, _
sMatch As String, _
Optional lCompare As Long = _
vbBinaryCompare) As Long
Dim lCount As Long
Dim lInStr As Long
Dim lLenMatch As Long
lLenMatch = Len(sMatch)
If Len(sStrIn) = 0 Or lLenMatch = 0 Then
zbCountInString = -1
Exit Function
End If
lInStr = InStr(1, sStrIn, sMatch, lCompare)
Do Until lInStr = 0
lCount = lCount + 1
lInStr = InStr(lInStr + lLenMatch, sStrIn, sMatch, lCompare)
Loop
zbCountInString = lCount
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
Const MY_STRING As String = _
"Ala ma Asa, a As ma Asa pikowego."
Const MY_FIND As String = "as"
Debug.Print "Por. tekstowe - ["; MY_FIND; "] występuje: "; _
zbCountInString(MY_STRING, MY_FIND, _
vbTextCompare); " razy"
Debug.Print "Por. binarne - ["; MY_FIND; "] występuje: "; _
zbCountInString(MY_STRING, MY_FIND); " razy"
DoCmd.RunCommand acCmdDebugWindow
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.3 Jak pobrać do tablicy (0 To 255) ilość wystąpień wszystkich pojedynczych znaków występujących w ciągu wejściowym ?
' wszystkie funkcje w argumencie ByRef zawsze zwracają tablicę arrRet(0 to 255) As Long, której poszczególne elementy określają ilośc wystąpień w ciągu wejściowym wszystkich znaków
' Metoda testowania szybkości procedur i funkcji:
' • wielokrotne wywołanie:
' - ciąg wejściowy: sStrIn = "!Ala;ma;Asa+,@a;Ola_ma-kota!"
' - ilość powtórzeń 10000
' • jednokrotne wywołanie dla długiego ciągu (ok. 57 000 znaków):
' sStrIn = ";Ala;ma;Asa;,;a;Ola;ma;kota !;"
' For i = 0 To 10
' sStrIn = sStrIn & sStrIn
' Next
' Metoda 1 - InStr(...)
' - przeszukuj ciąg wejściowy od początku i zliczaj wystąpienia znaku,
Private Sub zbCountCharsInStr( _
sStrIn As String, _
arrRet() As Long)
Dim lInStr As Long
Dim lCount As Long
Dim i As Long
ReDim arrRet(0 To 255)
For i = 0 To 255
lInStr = InStr(1, sStrIn, Chr$(i), vbBinaryCompare)
Do Until lInStr = 0
lCount = lCount + 1
lInStr = InStr(lInStr + 1, sStrIn, _
Chr$(i), vbBinaryCompare)
Loop
arrRet(i) = lCount
lCount = 0
Next
End Sub
' Metoda 2 - Replace(...)
' - zamień znak na ciąg zerowej długości i oblicz różnicę długości ciągów,
Private Sub zbCountCharsReplace( _
sStrIn As String, _
arrRet() As Long)
Dim lLenStr As Long
Dim i As Long
lLenStr = Len(sStrIn)
ReDim arrRet(0 To 255)
For i = 0 To 255
arrRet(i) = lLenStr - Len(Replace(sStrIn, _
Chr$(i), "", 1, -1, vbBinaryCompare))
Next
End Sub
' Metoda 3 - Split(...)
' - potraktuj znak jako separator i pobierz UBound tak otrzymanej tablicy,
Private Sub zbCountCharsSplit( _
sStrIn As String, _
arrRet() As Long)
Dim i As Long
ReDim arrRet(0 To 255)
For i = 0 To 255
arrRet(i) = UBound(Split(sStrIn, _
Chr$(i), -1, vbBinaryCompare))
Next
End Sub
' Metoda 4 - StrConv(...)
' - konwertuje ciąg znaków do tablicy bajtów i zlicza takie same elementy tablicy
Private Sub zbCountCharsStrConv( _
sStrIn As String, _
arrRet() As Long)
Dim arrBytes() As Byte
Dim i As Long
ReDim arrRet(0 To 255) As Long
arrBytes = StrConv(sStrIn, vbFromUnicode)
For i = 0 To UBound(arrBytes)
arrRet(arrBytes(i)) = arrRet(arrBytes(i)) + 1
Next
End Sub
' porównanie szybkości procedur:
' • sStrIn zawiera ok. 57 000 znaków
' 700% - zbCountCharsInStr
' 3 300% - zbCountCharsReplace
' 2 400% - zbCountCharsSplit
' 100% - zbCountCharsStrConv
' • 1000 powtórzeń dla sStrIn = "!Ala;ma;Asa+,@a;Ola_ma-kota!"
' 1 600% - zbCountCharsInStr
' 10 000% - zbCountCharsReplace
' 8 550% - zbCountCharsSplit
' 100% - zbCountCharsStrConv
przykładowe wywołanie:
Private Sub btnTest_Click()
Dim arrCountChars() As Long
Dim i As Long
Const MY_STRING As String = _
"Rzekł pajączek do pajączki:" & vbNewLine & _
"Popatrz, ja mam złote rączki!" & vbNewLine & _
"Już uprzędłem dla was nową" & vbNewLine & _
"Pajęczynę własnościową." & vbNewLine & _
"Będziesz pewnie bardzo rada," & vbNewLine & _
"Bo to cud, mucha nie siada!" & vbNewLine & _
"Na to ona z gniewem wrzaśnie:" & vbNewLine & _
"A ma, durniu, siadać właśnie!" & vbNewLine & _
" (Bogdan Brzeziński)" & vbNewLine & _
" ąćęłńóśżźĄĆĘŁŃŚŻŹ"
Call zbCountCharsStrConv(MY_STRING, arrCountChars())
' wydrukuj wystąpienia znaków
For i = 0 To 255
If arrCountChars(i) > 0 Then
Debug.Print i; "- [" & Chr$(i) & "]=" & arrCountChars(i)
End If
Next
DoCmd.RunCommand acCmdDebugWindow
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.4 Dlaczego w Access'ie 97 nie działa funkcja Split ?
' Takiej funkcji nie ma w Accessie 97. Pojawiła się ona dopiero w wersji Access 2000.
' zbSplit(..) - przy powodzniu zwraca -1 (True), w argumencie ByRef aArrayRet() As String zwraca tablicę elementów stringu wejściowego, które były rozdzielone separatorem,
' • przy błędzie zwraca 0 (False), zwracana tablica aArrayRet() jest pusta,
' • aArrayRet - zwracana ByRef tablica rozdzielonych elementów,
' • sStrIn ciąg wejściowy - jeżeli jest ciągiem zerowej długości "", to zwracana tablica aArrayRet() jest pusta, a funkcja zwraca 0 (False),
' • sDelim ciąg znaków dowolnej długości rozdzielajacy podciągi w ciągu wejściowym, jeżeli separator jest ciągiem zerowej długości "", lub separator nie występuje w ciągu wejściowym to pierwszy element zwracanej tablicy zawiera ciąg wejściowy,
' • lCount określa ilość podciągów jakie ma zwrócić funkcja, dla wartości <= -1 przeszukuje cały string wejściowy,
' • lCompare określa sposób porównywania ciągów,
Public Function zbSplit(sStrIn As String, _
arrRet() As String, _
Optional sDelim As String = " ", _
Optional lCount As Long = -1, _
Optional lCompare As Long = vbBinaryCompare) As Long
On Error GoTo ErrHandler
Dim arrInStr() As Long
Dim i As Long, j As Long, k As Long
Dim lLenD As Long
Dim lLenStrIn As Long
Dim sStrU As String
Dim sDelimU As String
lLenD = Len(sDelim)
lLenStrIn = Len(sStrIn)
' string wejściowy = ""
If lLenStrIn = 0 Then
Exit Function
End If
zbSplit = -1
' separator = "", lub jest dłuższy niż string wejściowy
' zwróć string wejściowy
If lLenD = 0 Or lLenD > lLenStrIn Then
ReDim arrRet(0)
arrRet(0) = sStrIn
Exit Function
End If
' określ opcję porównywania ciągów znaków
'If lCompare <> 0 Then
If StrComp("x", "X", lCompare) = 0 Then
sStrU = UCase(sStrIn)
sDelimU = UCase(sDelim)
Else
sStrU = sStrIn
sDelimU = sDelim
End If
' pobierz miejsca występowania separatorów (binarnie)
i = InStr(1, sStrU, sDelimU, vbBinaryCompare)
Do Until i = 0 Or j = lCount - 1
j = j + 1
ReDim Preserve arrInStr(j)
arrInStr(j) = i
i = InStr(i + lLenD, sStrU, sDelimU, vbBinaryCompare)
Loop
ReDim arrRet(0 To j)
' nie ma separatora w ciągu wejściowym
If j = 0 Then
arrRet(0) = sStrIn
Exit Function
End If
arrInStr(0) = 1 - Len(sDelim)
ReDim Preserve arrInStr(j + 1)
arrInStr(j + 1) = lLenStrIn + 1
For i = 0 To j
k = arrInStr(i) + lLenD
arrRet(i) = Mid$(sStrIn, k, arrInStr(i + 1) - k)
Next
ExitHere:
Exit Function
ErrHandler:
Erase arrRet
zbSplit = 0
Err.Raise Err.Number, "zbSplit", Err.Description, Err.HelpFile, Err.HelpContext
Resume ExitHere
End Function
' Porównanie zbSplit z wbudowaną funkcją Split w A2k:
' STRING: wywołanie: M$_Split zwraca tablicę typu string
' strArray = Split(sStrIn, ";", -1, Compare)
' • Compare = vbBinaryCompare lub vbTextCompare
' - wielokrotne wywoływanie - M$_Split jest ok. 60% szybsza,
' - jednokrotnie dla długiego ciągu - zbSplit jest ok. 60% szybsza,
' VARIANT: wywołanie: M$_Split zwraca zmienną typu Variant
' varArray = Split(sStrIn, ";", -1, Compare)
' • Compare = vbBinaryCompare lub vbTextCompare
' - wielokrotne wywoływanie - M$_Split jest ok. 150% szybsza,
' - jednokrotnie dla długiego ciągu - M$_Split jest ok. 200% szybsza,
' porównanie sposobu wywołania wbudowanej funkcji Split:
' zwraca zmienną typu Variant
' Dim varArray As Variant
' varArray = Split(sStrIn, ";", -1, Compare)
' zwraca tablicę typu String
' Dim strArray() As String
' strArray = Split(sStrIn, ";", -1, Compare)
' • Compare = vbBinaryCompare lub vbTextCompare
' - wielokrotne wywoływanie - zwrot do varArray jest ok. 50% szybsze,
' - jednokrotnie dla długiego ciągu - zwrot do varArray jest ok. 300% szybsze,
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim arrSplit() As String
Dim sStr As String
Dim i As Long
Const MY_TEXT As String = "!Ala;ma;Asa;,@a;Ola_ma;kota!"
If zbSplit(MY_TEXT, arrSplit(), ";") = -1 Then
For i = LBound(arrSplit()) To UBound(arrSplit())
Debug.Print arrSplit(i)
Next
End If
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.5 Dlaczego w Access'ie 97 nie działa funkcja Join ?
' Takiej funkcji nie ma w Accessie 97. Pojawiła się ona dopiero w wersji Access 2000.
' zbJoin(...) zwraca ciąg znaków utworzony przez połączenie elementów tablicy wejściowej,
' • arrStrIn() - tablica zawierająca ciągi znaków do połączenia,
' • sDelim - ciąg znaków jaki ma być wprowadzony pomiędzy łączone elementy tablicy, jeżeli jest ciągiem zerowej długości "" to do zwracanego ciągu nie jest dołączny separator
Public Function zbJoin( _
arrStrIn() As String, _
Optional sDelim As String = " ") As String
Dim sStrOut As String
Dim lLenStrOut As Long
Dim lStart As Long
Dim lEnd As Long
Dim lLenD As Long
Dim lOffset As Long
Dim i As Long
' arrStrIn() może być pusta
On Error Resume Next
lStart = LBound(arrStrIn)
lEnd = UBound(arrStrIn)
If Err.Number <> 0 Then
Err.Clear
Exit Function
End If
On Error GoTo 0
lLenD = Len(sDelim)
For i = lStart To lEnd
lLenStrOut = lLenStrOut + Len(arrStrIn(i))
Next
' pusta tablica wejściowa
If lLenStrOut = 0 Then Exit Function
' oblicz ilość znaków w ciągu wyjściowym
lLenStrOut = lLenStrOut + i * lLenD
' zapełnij string wyjściowy, (+ 1) => zabezpieczenie przed ciągiem zerowej długości "" w ostatnim elemencie tablicy wejściowej
sStrOut = String(lLenStrOut, vbNullChar)
lOffset = 1
If lLenD = 0 Then
' brak separatora - połącz elementy tablicy
For i = lStart To lEnd
Mid$(sStrOut, lOffset, lLenStrOut) = arrStrIn(i)
lOffset = lOffset + Len(arrStrIn(i))
Next
Else
For i = lStart To lEnd
Mid$(sStrOut, lOffset, lLenStrOut) = arrStrIn(i)
lOffset = lOffset + Len(arrStrIn(i))
Mid$(sStrOut, lOffset, lLenD) = sDelim
lOffset = lOffset + lLenD
Next
End If
zbJoin = Left$(sStrOut, lLenStrOut - lLenD)
End Function
' Porównanie zbJoin z wbudowaną funkcją Join w A2k
' • wielokrotne wywoływanie - M$_Join jest ok. 350% szybsza,
' • jednokrotnie dla długiego ciągu - M$_Join jest ok. 250% szybsza
przykładowe wywołanie:
Private Sub btnTest_Click()
Dim arrJoin(0 To 8) As String
arrJoin(0) = "Ala": arrJoin(1) = "ma": arrJoin(2) = "Asa":
arrJoin(3) = ",": arrJoin(4) = "a": arrJoin(5) = "As":
arrJoin(6) = "ma": arrJoin(7) = "pchły": arrJoin(8) = "!"
MsgBox zbJoin(arrJoin(), "/")
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.6 Dlaczego w Access'ie 97 nie działa funkcja Replace ?
' Takiej funkcji nie ma w Accessie 97. Pojawiła się ona dopiero w wersji Access 2000.
' zbReplace(...) - zamienia w ciągu wejściowym ciągi znaków sFind na ciągi
' znaków sReplace, począwszy od znaku lStart w ciągu wejściowym,
' • sStrIn - ciąg wejściowy zawierający podciągi znaków do zastąpienia,
' jeżeli sStrIn jest ciągiem zerowej długości - funkcja zwraca ciąg zerowej długości ("")
' • sFind - podciąg znaków do zamiany,
' jeżeli sFind jest ciągiem zerowej długości - funkcja zwraca ciąg wejściowy
' • sReplace - podciąg znaków na który ma zastąpić podciąg znaków do zamiany
' jeżeli sReplace jest ciągiem zerowej długości - funkcja usuwa w ciągu wejściowym
' wszystkie podciągi sFind
' • lStart - pozycja w ciągu wejściowym, od której będzie szukany podciąg do zamiany
' jeżeli lStart > Len(sStrIn) - funkcja zwraca ciąg zerowej długości ("")
' • lCount - ilość podciągów do zamiany, dla lCount < 0 zamienia wszystkie podciągi
' w ciągu wejściowym, jeżeli lCount = 0 - kopiuje ciąg wejściowy,
' • lCompare - określa sposób porównywania ciągów
Public Function zbReplace( _
ByVal sStrIn As String, _
sFind As String, _
sReplace As String, _
Optional lStart As Long = 1, _
Optional lCount As Long = -1, _
Optional lCompare As Long = _
vbBinaryCompare) As String
Dim arrInStr() As Long
Dim sStrOut As String
Dim lLenStrOut As Long
Dim lLenExpr As Long
Dim lLenFind As Long
Dim lLenReplace As Long
Dim lLenWord As Long
Dim lMidStart As Long
Dim lDelta As Long
Dim sStrU As String
Dim sFindU As String
Dim i As Long, j As Long
' szczególne przypadki wartości argumentów
lLenExpr = Len(sStrIn)
If lLenExpr = 0 Then Exit Function
lLenFind = Len(sFind)
If lLenFind = 0 Or lCount = 0 Then
zbReplace = sStrIn
Exit Function
End If
Select Case lStart
Case 1
Case Is > lLenExpr
Exit Function
Case Is > 1
sStrIn = Mid$(sStrIn, lStart)
Case Else
Err.Raise 5
End Select
' określ sposób porównywania ciągów
'If lCompare <> 0 Then
If StrComp("x", "X", lCompare) = 0 Then
sStrU = UCase(sStrIn)
sFindU = UCase(sFind)
Else
sStrU = sStrIn
sFindU = sFind
End If
i = InStr(1, sStrU, sFindU, vbBinaryCompare)
' znajdź miejsca występowania ciągu sFind (binarnie !)
Do Until i = 0 Or j = lCount
j = j + 1
ReDim Preserve arrInStr(j)
arrInStr(j) = i
i = i + lLenFind
i = InStr(i, sStrU, sFindU, vbBinaryCompare)
Loop
' nie ma separatora w ciągu wejściowym
If j = 0 Then
zbReplace = sStrIn
Exit Function
End If
arrInStr(0) = 1 - Len(sFind)
ReDim Preserve arrInStr(j + 1)
arrInStr(j + 1) = lLenExpr + 1
lLenReplace = Len(sReplace)
lDelta = lLenReplace - lLenFind
lLenStrOut = lLenExpr + lDelta * j + lLenReplace
' zapełnij ciąg docelowy, (+ 1) dodatkowy znak
sStrOut = String(lLenStrOut + 1, vbNullChar)
If lLenReplace = 0 Then
' usuń wszystkie podciągi
For i = 0 To j
lLenWord = arrInStr(i + 1) - (arrInStr(i) + lLenFind)
lMidStart = arrInStr(i) + lLenFind + lDelta * i
Mid$(sStrOut, lMidStart, lLenWord) = _
Mid$(sStrIn, arrInStr(i) + lLenFind, lLenWord)
Next
Else
' zamień podciągi
For i = 0 To j
lLenWord = arrInStr(i + 1) - (arrInStr(i) + lLenFind)
lMidStart = arrInStr(i) + lLenFind + lDelta * i
Mid$(sStrOut, lMidStart, lLenWord) = _
Mid$(sStrIn, arrInStr(i) + lLenFind, lLenWord)
Mid$(sStrOut, lMidStart + lLenWord, lLenReplace) = sReplace
Next
End If
zbReplace = Left$(sStrOut, lLenStrOut - lLenReplace)
End Function
' Porównanie zbReplace z wbudowaną funkcją Replace w A2k
' • Compare = vbBinaryCompare lub vbTextCompare
' - wielokrotne wywoływanie - M$_Replace jest ok. 150% szybsza,
' - jednokrotnie dla długiego ciągu - zbReplace jest ok. 25% szybsza
' przykładowe wywołanie:
Private Sub btnTest_Click()
MsgBox zbReplace("Ala ma Asa, a As ma pchły !", "As", "Kot")
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.7 Dlaczego w Access'ie 97 nie działa funkcja StrReverse ?
' Takiej funkcji nie ma w Accessie 97. Pojawiła się ona dopiero w wersji Access 2000.
' zbStrReverse(...) - zwraca ciąg znaków w którym kolejność znaków jest odwrócona,
' • sStrIn - wejściowy ciąg znaków, jeżeli jest ciągiem zerowej długości - funkcja zwraca ciąg zerowej długości,
Public Function zbStrReverse(sStrIn As String) As String
Dim arrIn() As Byte
Dim arrRev() As Byte
Dim lUB As Long
Dim i As Long
arrIn = StrConv(sStrIn, vbFromUnicode)
lUB = UBound(arrIn)
If lUB = -1 Then Exit Function
ReDim arrRev(lUB)
For i = 0 To lUB
arrRev(i) = arrIn(lUB - i)
Next
zbStrReverse = StrConv(arrRev, vbUnicode)
End Function
' Porównanie zbStrReverse z wbudowaną funkcją StrReverse w A2k
' M$_StrReverse jest nieporównywalnie szybsza (ok.30 razy) od zbStrReverse,
' • brak prostej, szybkiej metody odwracania ciągów znaków powoduje również bardzo wolne działanie opisanej poniżej funkcji zbInStrRev,
' przykładowe wywołanie:
Private Sub btnTest_Click()
MsgBox zbStrReverse("Kobyła ma mały bok")
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.8 Dlaczego w Access'ie 97 nie działa funkcja InStrRev ?
' Takiej funkcji nie ma w Accessie 97. Pojawiła się ona dopiero w wersji Access 2000.
' zbInStrRev (...) - przeszukuje ciąg wejściowy od początku
' zwraca pozycję ostatniego wystąpienia szukanego ciągu znaków w stringu wejściowym, jeżeli szukany ciąg nie występuje - zwraca 0
' • sCheck - przeszukiwany ciąg znaków, jeżeli sCheck jest ciągiem zerowej długości - zwraca 0
' • sMatch - szukany ciąg znaków, jeżeli sMatch jest ciągiem zerowej długości - zwraca lStart,
' • lStart - pozycja w ciągu wejściowym, od której będzie szukany podciąg do zamiany, jeżeli lStart > Len(sCheck) - funkcja - zwraca 0
' • lCompare - określa sposób porównywania ciągów,
Public Function zbInStrRev( _
ByVal sCheck As String, _
ByVal sMatch As String, _
Optional ByVal lStart As Long = -1, _
Optional lCompare As Long = _
vbBinaryCompare) As Long
Dim lInStr As Long
If Len(sCheck) = 0 Then Exit Function
If Len(sMatch) = 0 Then
zbInStrRev = lStart
Exit Function
End If
If lStart > Len(sCheck) Then Exit Function
If lStart = 0 Or lStart < -1 Then Err.Raise 5
If lStart > 0 Then
sCheck = Left$(sCheck, lStart)
End If
' określ sposób porównywania ciągów
' If lCompare <> 0 Then
If StrComp("x", "X", lCompare) = 0 Then
sCheck = UCase(sCheck)
sMatch = UCase(sMatch)
End If
' szukaj od początku
lStart = 0
Do
lStart = lInStr + 1
lInStr = InStr(lStart, sCheck, sMatch, vbBinaryCompare)
Loop Until lInStr = 0
zbInStrRev = lStart - 1
End Function
' InStrRevBis (...) - przeszukuje ciąg wejściowy od końca, znak po znaku, jest (może być) trochę szybsza, jeżeli szukany ciąg znaków znajduje się blisko końca ciągu wejściowego,
Public Function zbInStrRevBis( _
ByVal sCheck As String, _
ByVal sMatch As String, _
Optional ByVal lStart As Long = -1, _
Optional lCompare As Long = _
vbBinaryCompare) As Long
Dim lInStr As Long
Dim lLenCheck As Long
lLenCheck = Len(sCheck)
If lLenCheck = 0 Then Exit Function
If Len(sMatch) = 0 Then
zbInStrRevBis = lStart
Exit Function
End If
If lStart > lLenCheck Then Exit Function
If lStart = 0 Or lStart < -1 Then Err.Raise 5
If lStart > 0 Then
sCheck = Left$(sCheck, lStart)
End If
' określ sposób porównywania ciągów
' If lCompare <> 0 Then
If StrComp("x", "X", lCompare) = 0 Then
sCheck = UCase(sCheck)
sMatch = UCase(sMatch)
End If
' szukaj od końca
lStart = lLenCheck
Do
lInStr = InStr(lStart, sCheck, sMatch, vbBinaryCompare)
lStart = lStart - 1
Loop Until lInStr <> 0 Or lStart = 0
zbInStrRevBis = lInStr
End Function
' Porównanie zbInStrRev z wbudowaną funkcją InStrRev w A2k:
' • M$_InStrRev jest zdecydowanie szybsza, w zalezności od długości ciągu wejściowego i położenia poszukiwanego ciągu, od kilku do kilkunastu razy, dla skrajnie niekorzystnych ciągów do kilkudziesięciu razy.
' • Z powodu wolnego działania zbInStrRev, należy w Access'97 korzystać z wbudowanej funkcji InStr(...) przeszukującej ciąg znaków od początku !
ΔΔΔ | | | | |
|
|
| | |
|
4.9 Jak rozpoznać, czy tekst jest pisany w całości dużymi lub małymi literami ?
' przykładowe wywołanie:
Private Sub btnTest_Click()
Const MY_TEXT As String = "TO JEST MÓJ TEKST !"
If StrComp(UCase(MY_TEXT), _
MY_TEXT, vbBinaryCompare) = 0 Then
MsgBox MY_TEXT & vbNewLine & _
vbNewLine & "Tylko duże litery."
ElseIf StrComp(LCase(MY_TEXT), _
MY_TEXT, vbBinaryCompare) = 0 Then
MsgBox MY_TEXT & vbNewLine & _
vbNewLine & "Tylko małe litery."
Else
MsgBox MY_TEXT & vbNewLine & _
vbNewLine & "Tekst mieszany."
End If
End Sub
ΔΔΔ | | | | |
|
| |
