图书馆图书查找器 - 替换为突出显示的字符串自身

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### 函数'仅返回 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

请使用下一个功能。它返回出现位置和字符串长度。我不明白要找到的字符串的数字组是否总是由三位数字组成。该功能允许从 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 中一样被调用（和使用）：

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 对象，因此不必选择参考库。

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")