在列表框中输入内容时筛选多个列

• 下载工作文件的副本。

工作表模块，例如Glossar(Glossar)

Option Explicit

Private Sub GlossarySearchBox_Change()
    FilterByStrippedColumn_Change
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    JoinLanguageColumnsInStrippedColumn_Change Target
End Sub

标准模块，例如Module1

Option Explicit

' Assumptions:
' - The table is never empty.
' - There are at least 2 columns.
' - The last column is the Stripped column.
' - There are only Language columns between the first Language column (incl.)
' - and the Stripped column (excl.).

' Module-Level

' Constants
Private Const GLOSSARY_TABLE_NAME As String = "Glossar"
Private Const GLOSSARY_SEARCH_CELL_ADDRESS As String = "B2"
Private Const GLOSSARY_FIRST_LANGUAGE_COLUMN As Long = 2
Private Const DIACRITICAL_STRING As String = "àáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Private Const STRIPPED_STRING As String = "aaaaaaceeeeiiiinooooouuuuyy"
Private Const JOIN_DELIMITER As String = "\"
Private Const MINIMUM_CHARACTERS As Long = 2 ' minimally 1
' Variables
Private WasStrippedColumnPopulated As Boolean
        
' Shape Calls
    
Sub ClearSearchCell_Click()
    ClearSearchCell
End Sub
    
Sub ClearStrippedColumn_Click()
    ClearStrippedColumn
End Sub

Sub RebuildStrippedColumn_Click()
    RebuildStrippedColumn
End Sub

' Event Calls

' Called by 'Worksheet_Change'
Sub JoinLanguageColumnsInStrippedColumn_Change(ByVal Target As Range)
    
    Dim trg As Range: Set trg = Intersect(RefLanguageColumns, Target)
    If trg Is Nothing Then Exit Sub
    
    JoinLanguageColumnsInStrippedColumn trg
    WasStrippedColumnPopulated = True
    
End Sub

' Called by 'SearchBox_Change'
Sub FilterByStrippedColumn_Change()
    FilterByStrippedColumn
End Sub

' Private Functions
        
Private Function RefTable() As ListObject
    Set RefTable = Glossar.ListObjects(GLOSSARY_TABLE_NAME)
End Function
     
Private Function RefLanguageColumns() As Range
    With RefTable.DataBodyRange
        Set RefLanguageColumns = _
            .Resize(, .Columns.Count - GLOSSARY_FIRST_LANGUAGE_COLUMN) _
            .Offset(, GLOSSARY_FIRST_LANGUAGE_COLUMN - 1)
    End With
End Function

Private Function RefSearchCell() As Range
    Set RefSearchCell = Glossar.Range(GLOSSARY_SEARCH_CELL_ADDRESS)
End Function
        
Private Function GetSearchString() As String
    GetSearchString = LCase(CStr(RefSearchCell.Value))
End Function

' Private Subs

Private Sub ClearSearchCell()
    RefSearchCell.Value = vbNullString ' triggers the SearchBox_Change event
End Sub

Private Sub ClearStrippedColumn()
    Dim lo As ListObject: Set lo = RefTable
    ClearTableFilters lo
    With lo.DataBodyRange
        .Columns(.Columns.Count).ClearContents
    End With
    WasStrippedColumnPopulated = False
End Sub

Private Sub RebuildStrippedColumn()
    Dim lo As ListObject: Set lo = RefTable
    ClearTableFilters lo
    JoinLanguageColumnsInStrippedColumn lo.DataBodyRange
    WasStrippedColumnPopulated = True
End Sub

Private Sub ClearTableFilters(ByVal lo As ListObject)
    With lo
        If .ShowAutoFilter Then ' is turned on
            If .AutoFilter.FilterMode Then ' is auto-filtered
                .AutoFilter.ShowAllData ' clear filters
            End If
        Else ' is turned off
            .Range.AutoFilter ' turn on
        End If
    End With
End Sub

Private Sub FilterByStrippedColumn()
    Application.ScreenUpdating = False
        Dim lo As ListObject: Set lo = RefTable
        ClearTableFilters lo
        Dim SearchString As String: SearchString = GetSearchString
        If Len(SearchString) >= MINIMUM_CHARACTERS Then
            lo.Range.AutoFilter _
                Field:=lo.ListColumns.Count, _
                Criteria1:="*" & SearchString & "*"
        End If
    Application.ScreenUpdating = True
End Sub

Private Sub JoinLanguageColumnsInStrippedColumn(ByVal rg As Range)
    
    Const PROC_TITLE As String = "Join Language Columns in Stripped Column"
    
    Dim lrg As Range: Set lrg = Intersect(rg.EntireRow, RefLanguageColumns)
    If lrg Is Nothing Then Exit Sub
    
    Dim ColumnsCount As Long: ColumnsCount = lrg.Columns.Count
    Dim DelLen As Long: DelLen = Len(JOIN_DELIMITER)
    
    Dim arg As Range, aData() As Variant, r As Long, c As Long, Text As String

    On Error Goto ClearError
    
    Application.EnableEvents = False
    
    For Each arg In lrg.Areas
        aData = arg.Value
        For r = 1 To UBound(aData, 1)
            Text = vbNullString
            For c = 1 To ColumnsCount
                Text = Text & aData(r, c) & JOIN_DELIMITER
            Next c
            Text = Left(Text, Len(Text) - DelLen) ' remove trailing delimiter
            StripDiacritics Text
            aData(r, 1) = Text
        Next r
        arg.Columns(1).Offset(, ColumnsCount).Value = aData
    Next arg

ProcExit:
    On Error Resume Next
        Application.EnableEvents = True
        WasStrippedColumnPopulated = True
    On Error GoTo 0
    Exit Sub
ClearError:
    MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub

Private Sub StripDiacritics(ByRef Text As String)
    
    Text = LCase(Text)
    
    Dim n As Long, MatchedCharPosition As Long, Char As String
    
    For n = 1 To Len(Text)
        Char = Mid(Text, n, 1)
        MatchedCharPosition = InStr(DIACRITICAL_STRING, Char)
        If MatchedCharPosition > 0 Then
            Text = Replace(Text, _
                Mid(DIACRITICAL_STRING, MatchedCharPosition, 1), _
                Mid(STRIPPED_STRING, MatchedCharPosition, 1))
        End If
    Next n
    
End Sub