包含值列表的近似筛选数据的excel vba代码

Sub FilterData()
    Dim ws As Worksheet
    Dim rng As Range
    Dim filterValue As String
    Dim filteredData As Range
    
    ' 设置工作表和筛选范围
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rng = ws.Range("A1:A10") ' 假设数据在A1:A10范围内
    
    ' 获取筛选值
    filterValue = InputBox("请输入筛选值:")
    
    ' 清除之前的筛选结果
    ws.AutoFilterMode = False
    
    ' 应用筛选
    rng.AutoFilter Field:=1, Criteria1:="*" & filterValue & "*", Operator:=xlAnd
    
    ' 获取筛选结果
    Set filteredData = rng.SpecialCells(xlCellTypeVisible)
    
    ' 在新的工作表中显示筛选结果
    Dim newWs As Worksheet
    Set newWs = ThisWorkbook.Worksheets.Add
    filteredData.Copy newWs.Range("A1")
    
    ' 清除筛选
    ws.AutoFilterMode = False
    
    ' 提示筛选结果
    MsgBox "筛选结果已显示在新的工作表中。"
End Sub