Library Book Finder - 替换为突出显示的 String of Itself

Question

我有一个名为 strLibrary 的大字符串（超过 255 个字符）。

此字符串在整个图书馆中都有随机文本和书籍位置。书籍位置始终采用 'Floor###Column###Shelf###' IE Floor149Column423Shelf876 格式。我希望能够找到 Floor###Column###Shelf### 之类的所有字符串，然后在名为 txtLibrary 的富文本框中突出显示它们，以便于查看。

请注意，整个随机文本可能包含单词“Floor”和或“Column”和或“Shelf”，而不是字符串格式 Floor###Column# ##Shelf### 所以只突出显示 Floor###Column###Shelf###.

格式的字符串很重要

过去，如果我想在富文本框中突出显示单词（例如单词 Book），我会使用以下方法：

strLibrary_RICH = Replace(strLibrary, "Book", "<font style =""BACKGROUND-COLOR:#FFFF00"">"Book"</font>")

Me.txtLibrary = strLibrary_RICH

'strLibrary like Floor###Column###Shelf### function'只有returns一个TRUE/FALSE的结果。所以使用以下内容不起作用：

Dim strLibrary_RICH     AS String
Dim strHighlight        AS String

If (strLibrary Like *Floor###Column###Shelf###*) Then

strHighlight = (strLibrary Like *Floor###Column###Shelf###*)

strLibrary_RICH = Replace(" & strHighlight & ","<font style =""BACKGROUND-COLOR:#FFFF00"">" & strHighlight & "</font>")

End If

Me.txtLibrary = strLibrary_RICH

有没有办法从 strLibrary 中搜索 Floor###Column###Shelf### 之类的所有字符串并在富文本框 txtLibrary 中突出显示它们？

Answer 1

请使用下一个功能。它returns出现位置和字符串长度。我不明白要找到的字符串的数字组是否总是由三位数字组成。该功能允许从 1 到 5（如有必要，可以轻松增加......）。根据返回的数组，可以使用Mid标准VBA函数找到字符串：

Function extractFloorCh(strLibrary As String, Optional iStart As Long = 1) As Variant
   Dim lngFl As Long, arr(1) As Variant
   Dim i As Long, j As Long, k As Long
   
Retry:
   lngFl = InStr(iStart, strLibrary, "Floor")
   If lngFl > 0 Then
        For i = 1 To 5
            If Not IsNumeric(Mid(strLibrary, lngFl + 4 + i, 1)) Then
               If Mid(strLibrary, lngFl + 4 + i, 6) <> "Column" Then
                    iStart = lngFl + 5: GoTo Retry
               Else
                    For j = 1 To 3
                        If Not IsNumeric(Mid(strLibrary, lngFl + 4 + 5 + i, 1)) Then
                            For k = 1 To 5
                                If Not IsNumeric(Mid(strLibrary, lngFl + 4 + 14 + i + k, 1)) Then
                                    arr(0) = lngFl: arr(1) = 4 + 14 + i + k
                                    extractFloorCh = arr: Exit Function
                                End If
                            Next k
                        End If
                    Next
               End If
            End If
        Next i
   End If
End Function

可以像在下一个测试子中那样调用（和使用）函数：

Sub testExtractStrHighlight()
  Dim x As String, y As String, strLibrary As String, arr As Variant, i As Long, strHighlight As String
  
  x = "Floor149Column423Shelf876": y = "Floor222Column444Shelf888"
  strLibrary = "dfgrty whatever  jutygt jhggffffFloorghjk" & x & "werer Column" & y & "tFlooruyuColumni"
  arr = 1 'for first function call...
  For i = 1 To 1000 'you can use here whatever you suppose to exceed the occurrences number
    If IsArray(arr) Then
       arr = extractFloorCh(strLibrary, arr(0) + arr(1))
    Else
        arr = extractFloorCh(strLibrary)
    End If
    If IsArray(arr) Then
       strHighlight = Mid(strLibrary, arr(0), arr(1))
       Debug.Print strHighlight
       'do here what you need with the returned string...
       '......
       '...
    Else
        Exit For
    End If
  Next i
End Sub

Answer 2

这使用具有后期绑定的 RegExp 对象，因此不必 select 引用库。

Function Highlight(strS As String, strP As String, strC As String)
Dim regexOne As Object, Matches As Object, Match As Object
'Set regexOne = New RegExp
Set regexOne = CreateObject("VBScript.RegExp")
regexOne.Pattern = strP
regexOne.Global = True
Set Matches = regexOne.Execute(strS)
For Each Match In Matches
    strS = Replace(strS, Match.Value, "<font style=BACKGROUND-COLOR:#" & strC & ">" & Match.Value & "</font>")
Next
Highlight = strS
End Sub

调用函数：

SELECT *, Highlight(fieldname, "Floor[0-9]+Column[0-9]+Shelf[0-9]+", "FFFFFF") AS HighlightText FROM table;
或
UPDATE table SET fieldname = Highlight(fieldname, "Floor[0-9]+Column[0-9]+Shelf[0-9]+", "FFFF00")

Library Book Finder - 替换为突出显示的 String of Itself

Library Book Finder - Replace with highlighted String of Itself

ms-access

vba

if-statement

str-replace