带高亮显示的动态搜索 - Excel VBA

Posted 2023-03-06

【中文标题】带高亮显示的动态搜索 - Excel VBA

【英文标题】：Dynamic Search with highlight - Excel VBA

【发布时间】：2018-01-01 19:24:54

【问题描述】：

我想实现以下目标： 在我的 excel 表中，我有一组数据，我通过创建一个“搜索框”对其应用了动态过滤。 过滤本身可以正常工作，那里没有问题，但是，我想进一步改进它，通过以红色突出显示过滤行中的文本（输入到搜索框中）。 我附上了我希望在最终版本中看到的屏幕截图。

知道如何将其输入到我当前的代码中吗？

一如既往，非常感谢任何帮助！ 谢谢！

下面是我用于动态过滤的代码：

Private Sub TextBox1_Change()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


If Len(TextBox1.Value) = 0 Then
    Sheet1.AutoFilterMode = False
Else
    If Sheet1.AutoFilterMode = True Then
        Sheet1.AutoFilterMode = False
        End If

    Sheet1.Range("B4:C" & Rows.Count).AutoFilter field:=1, Criteria1:="*" & TextBox1.Value & "*"

    End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

【参考方案1】：

考虑这样的事情 - 在工作表中写下以下内容：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target <> Range("a1") Then Exit Sub
    SelectAndChange (Target)

End Sub

Private Sub SelectAndChange(strValue As String)

    Dim rngCell     As Range
    Dim rngRange    As Range
    Dim strLookFor  As String
    Dim arrChar     As Variant
    Dim lngCounter  As Long

    If strValue = vbNullString Then Exit Sub

    Application.EnableEvents = False

    Set rngRange = Range("E1:E10")
    rngRange.Font.Color = vbBlack
    strLookFor = Range("A1").Value

    For Each rngCell In rngRange
        For lngCounter = 1 To Len(rngCell) - Len(strLookFor) + 1
            If Mid(rngCell, lngCounter, Len(strLookFor)) = strLookFor Then
                rngCell.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed
            End If
        Next lngCounter
    Next rngCell

    Application.EnableEvents = True

End Sub

E1:E10 中的值将取决于A1 中的值，如下所示：

【讨论】：

感谢您的代码！这似乎适用于我的代码，但是，有一个小问题。对我来说，如果我双击单元格（A1），字符只会变成红色。我想实时看到这一点。另外，由于某种原因，如果我删除文本，字符仍然是红色的。这些有什么解决办法吗？ :) 否则，真的很好！

@llorcs - 要“实时”查看操作，请从代码中删除此行：If Target <> Range("a1") Then Exit Sub

关于空单元格，这使得所有的值都变成红色，大约有10种方法可以解决这个问题。其中之一是在代码中添加If strValue = vbNullString Then Exit Sub。我已经添加了它。 @llorcs