如何以换行符为分隔符实现Excel多选项单元格的单独筛选？

问题背景 #

你现有的VBA代码实现了在B-H列（第2-8列）通过数据验证下拉选择多个选项，选中项以换行符分隔在单个单元格内，但Excel默认筛选会将每个带多行内容的单元格视为独立筛选类别，无法直接按单个选项筛选。

Dim Oldvalue As String
Dim Newvalue As String

Application.EnableEvents = True

On Error GoTo Exitsub

Select Case Target.Column
    Case 2, 3, 4, 5, 6, 7, 8
      If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
      Else: If Target.Value = "" Then GoTo Exitsub Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
          If Oldvalue = "" Then
            Target.Value = Newvalue
          Else
            If InStr(1, Oldvalue, Newvalue) = 0 Then
                Target.Value = Oldvalue & vbNewLine & Newvalue
          Else:
            Target.Value = Oldvalue
          End If
        End If
      End If
End Select

Exitsub:
Application.EnableEvents = True

End Sub

解决方案 #

方案1：使用Excel内置函数（适用于Excel 365/2021及以上）

无需修改原VBA，通过辅助列实现单个选项筛选：

• 在数据区域右侧插入新列（例如I列），表头命名为「拆分选项」
• 在该列第一行数据单元格（如I2）输入公式：=TEXTSPLIT(B2, CHAR(10),,TRUE)，其中B2对应原数据单元格，可根据实际列调整
• 下拉填充公式，原单元格的多行选项会自动拆分为垂直排列的单个选项
• 选中包含辅助列的整个数据区域，点击「数据」→「筛选」，此时筛选辅助列即可看到所有单个选项，选中后会自动筛选出对应原数据行

方案2：修改VBA自动维护辅助列（兼容所有Excel版本）

针对无TEXTSPLIT函数的旧版Excel，可修改原VBA，在多选操作时同步维护辅助列：

Dim Oldvalue As String
Dim Newvalue As String
Dim ws As Worksheet
Dim helperCol As Integer

Set ws = Target.Worksheet
helperCol = 9 ' 辅助列设为第9列（I列），可按需调整

Application.EnableEvents = True
On Error GoTo Exitsub

Select Case Target.Column
    Case 2, 3, 4, 5, 6, 7, 8 ' 原目标列范围
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        End If
        
        If Target.Value = "" Then
            ws.Cells(Target.Row, helperCol).ClearContents
            GoTo Exitsub
        End If
        
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        
        If Oldvalue = "" Then
            Target.Value = Newvalue
            ws.Cells(Target.Row, helperCol).Value = Newvalue
        Else
            If InStr(1, Oldvalue, Newvalue) = 0 Then
                Target.Value = Oldvalue & vbNewLine & Newvalue
                ' 将换行分隔的选项转为逗号分隔，方便筛选
                ws.Cells(Target.Row, helperCol).Value = Replace(Target.Value, vbNewLine, ", ")
                ' 若需将每个选项拆分到单独单元格，替换上一句为：
                ' ws.Range(ws.Cells(Target.Row, helperCol), ws.Cells(Target.Row, helperCol + UBound(Split(Target.Value, vbNewLine)))).Value = Split(Target.Value, vbNewLine)
            Else
                Target.Value = Oldvalue
                ws.Cells(Target.Row, helperCol).Value = Replace(Target.Value, vbNewLine, ", ")
            End If
        End If
End Select

Exitsub:
Application.EnableEvents = True

• 代码会在用户选择多选时，同步将选项更新到辅助列（可选择逗号分隔或拆分到相邻单元格）
• 筛选辅助列即可按单个选项过滤数据

临时筛选技巧（无需修改）

若仅需偶尔筛选单个选项，可直接使用Excel自带的「文本筛选」→「包含」，输入目标选项内容，即可筛选出所有包含该选项的行，但这种方式不会在筛选界面列出所有单个选项。

内容的提问来源于stack exchange，提问作者Megan