带突出显示的动态搜索 - Excel VBA

时间:2017-07-26 12:50:01

标签: excel vba dynamic filtering highlight

我想实现以下目标: 在我的Excel工作表中,我有一组数据,我通过创建一个"搜索框"来应用动态过滤。 过滤本身工作正常,没有任何问题,但是,我想进一步改进它,通过突出显示红色过滤行中的文本(在搜索框中输入)。 我附上了我希望在最终版本中看到的截图。

enter image description here

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

一如既往,非常感谢任何帮助! 谢谢!

以下是我用于动态过滤的代码:

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 个答案:

答案 0 :(得分:0)

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

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中的值,如下所示:

enter image description here