• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

InStr - InStrWholeWord

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Hình đại diện của người dùng
BasicVB
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 75
Ngày tham gia: T.Bảy 29/03/2008 2:07 pm
Liên hệ:

InStr - InStrWholeWord

Gửi bàigửi bởi BasicVB » CN 30/03/2008 9:02 pm

Thủ thuật: InStrWholeWord
Tác giả: Sưu tầm
Mô tả: Tìm kiếm .... kiểu wholeword :D


Mã: Chọn hết

  1. Option Explicit
  2. 'If you want to exclude hyphans you could add '!-' to this constant
  3. Private Const strNotLetterFilter       As String = "[!a-z!A-Z!À-Ö!Ø-ß!à-ö!ø-ÿ]"
  4.  
  5. Public Function ContainsWholeWord(ByVal strSearch As String, _
  6.                                   ByVal strFind As String, _
  7.                                   Optional Start As Long = 1, _
  8.                                   Optional CaseSensitive As VbCompareMethod = vbBinaryCompare) As Boolean
  9.  
  10. 'How it works
  11. 'strSearch =string to search in
  12. 'strFind   = string to look for
  13. 'Start Optional Default =1; If you want to ignore earlier parts of strSearch set Start
  14. '                           (Could be used to scan through a string)
  15. 'CaseSensitive Optional Default = vbBinaryCompare;
  16. '                          Set to vbTextCompare to find word in any case.
  17. 'NOTE: MS have cheated by using something in InStr which they didn't provide in VB;
  18. 'an optional 1st parameter. To use the optional Compare argument you also have to provide the Start value.
  19. 'my Function places the Compare argument after the Find parameter and you only need to provide it if it is not default = 1
  20. '
  21. 'Pad strSearch so you can detect first/last word
  22. '* accept anything (including nothing) before 1st * and after last *.
  23. '[!a-z!A-Z!À-Ö!Ø-ß!à-ö!ø-ÿ] accept any 1 character which is NOT(!) between a-z or A-Z or any of the high ASCII letter characters
  24. '
  25. 'Small potential bug: if strFind = '*ry" then containsWholeWord will hit (* messes with the Like search)
  26. 'could be exploited to build an end of word matcher if you want to try building a rhyming dictionary ;)
  27.  
  28.   strSearch = Mid$(strSearch, Start)
  29.   If CaseSensitive = vbBinaryCompare Then
  30.     ContainsWholeWord = " " & strSearch & " " Like "*" & strNotLetterFilter & strFind & strNotLetterFilter & "*"
  31.    Else
  32.     ContainsWholeWord = LCase$(" " & strSearch & " ") Like "*" & strNotLetterFilter & LCase$(strFind) & strNotLetterFilter & "*"
  33.   End If
  34.  
  35. End Function
  36.  
  37. Public Function InStrWholeWord(ByVal strSearch As String, _
  38.                                ByVal strFind As String, _
  39.                                Optional Start As Long = 1, _
  40.                                Optional CaseSensitive As VbCompareMethod = vbBinaryCompare) As Long
  41.  
  42.   Dim TPos As Long
  43.  
  44. 'How it works
  45. 'ByVal parameters let you manipulate the strings without worrying about them being damaged outside the Function
  46. 'strSearch =string to search in
  47. 'strFind   = string to look for'Start Optional Default =1; If you want to ignore earlier parts of strSearch set Start
  48. '                           (Could be used to scan through a string)
  49. 'CaseSensitive Optional Default = vbBinaryCompare;
  50. '                          Set to vbTextCompare to find word in any case.
  51. 'NOTE: MS have cheated by using something in InStr which they didn't provide in VB;
  52. 'an optional 1st parameter. To use the optional Compare argument you also have to provide the Start value.
  53. 'my Function places the Compare argument after the Find parameter and you only need to provide it if it is not default = 1
  54.   If Start > 1 Then
  55. 'To speed the Function cut the unneeded part off
  56.     strSearch = Mid$(strSearch, Start)
  57.   End If
  58.   If ContainsWholeWord(strSearch, strFind, 1, CaseSensitive) Then
  59. 'Quick and Dirty test before more complex stuff
  60.     If Not CaseSensitive = vbBinaryCompare Then
  61. 'case switching is time consuming only do if necessary
  62.       strSearch = LCase$(strSearch)
  63.       strFind = LCase$(strFind)
  64.     End If
  65.     TPos = InStr(strSearch, strFind)
  66. 'Get inital test point then
  67.     If TPos Then
  68. 'Small potential bug: if strFind = '*ry" then containsWholeWord will hit (* messes with the Like search) but Tpos will be 0
  69. 'Loop through strSearch testing for possible matches
  70.       Do
  71.         If TPos = 1 Then
  72.           If strSearch = strFind Then
  73.             InStrWholeWord = 1
  74.             Exit Do
  75.           End If
  76. 'if first position is 1 then test that char after len(strFind) is not a letter
  77.           If Mid$(strSearch, Len(strFind) + 1, 1) Like strNotLetterFilter Then
  78.             InStrWholeWord = 1
  79.             Exit Do
  80.           End If
  81.          ElseIf Mid$(strSearch, TPos - 1, 1) Like strNotLetterFilter Then
  82. 'else test that char before is also not a letter
  83.           If TPos + Len(strFind) - 1 = Len(strSearch) Then
  84. 'if at very end of string
  85.             InStrWholeWord = TPos
  86.             Exit Do
  87.            ElseIf Mid$(strSearch, TPos + Len(strFind), 1) Like strNotLetterFilter Then
  88. 'else test that char after is not a letter
  89.             InStrWholeWord = TPos
  90.             Exit Do
  91.           End If
  92.         End If
  93. 'if Standard InStr was wrong try next match
  94.         TPos = InStr(TPos + 1, strSearch, strFind)
  95. 'Loop while possible
  96.       Loop While TPos
  97.     End If
  98.   End If
  99.   If InStrWholeWord Then
  100. 'reapply start value to get true length
  101.     InStrWholeWord = InStrWholeWord + Start - 1
  102.   End If
  103.  
  104. End Function
  105.  
  106. Public Function PosInStringWholeWord(ByVal strSearch As String, _
  107.                                      ByVal strFind As String, _
  108.                                      Optional Start As Long = 1, _
  109.                                      Optional CaseSensitive As VbCompareMethod = vbBinaryCompare) As Long
  110.  
  111.   Dim TPos   As Long
  112.  
  113.   TPos = InStrWholeWord(strSearch, strFind, Start, CaseSensitive)
  114.   If TPos Then
  115.     PosInStringWholeWord = UBound(Split(Left$(strSearch, TPos))) + 1
  116.   End If
  117.  
  118. End Function
  119.  
  120. ':)Roja's VB Code Fixer V1.1.92 (7/02/2004 9:01:52 PM) 3 + 109 = 112 Lines Thanks Ulli for inspiration and lots of code.


Sử dụng :

Mã: Chọn hết

  1. InStrWholeWord(ByVal strSearch As String, _
  2.                                ByVal strFind As String, _
  3.                                Optional Start As Long = 1, _
  4.                                Optional CaseSensitive As VbCompareMethod = vbBinaryCompare) As Long


Mã: Chọn hết

  1. strSearch = chuỗi tìm kiếm
  2. strFind = nội dung tìm kiếm
  3. Start = vị trí bắt đầu tìm
  4. CaseSensitive = kiểu so sánh



Quay về “[VB] Chuỗi và Thời gian”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách