请教VBA字典法多条件筛选数据的方法

KeroBerus

如图，很简单，就是参照相应的条件，在数据表中筛选出符合条件的数据并把它们显示在指定区域。
以下是我的代码，已经实现了我要的功能，但这个数据表是精简过的，查询条件也不多，条件一旦多起来，用IF做这样的逻辑判断会比较复杂，所以特来请教有没有别的更好的方法，谢谢大家！

Private Sub CommandButton1_Click()

Dim FArr, ReArr, RArr
Dim Dic

FArr = Range("A3:E12")
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(FArr)
    If [I6].Value = 0 Then
        If FArr(i, 2) = [I2].Value And FArr(i, 3) = [I4].Value And FArr(i, 4) = [I8].Value Then
            Dic(FArr(i, 1)) = FArr(i, 1) & "_" & FArr(i, 2) & "_" & FArr(i, 3) & "_" & FArr(i, 4) & "_" & FArr(i, 5)
        End If
    Else
        If (FArr(i, 2) >= [I2].Value - [I6].Value) And (FArr(i, 2) <= [I2].Value + [I6].Value) And (FArr(i, 3) >= [I4].Value - [I6].Value) And (FArr(i, 3) <= [I4].Value + [I6].Value) And FArr(i, 4) = [I8].Value Then
            Dic(FArr(i, 1)) = FArr(i, 1) & "_" & FArr(i, 2) & "_" & FArr(i, 3) & "_" & FArr(i, 4) & "_" & FArr(i, 5)
        End If
    End If
Next i
If Not Dic.Count = 0 Then
    ReArr = Dic.Items
    Range("A16:E65536").ClearContents
    For i = 0 To Dic.Count - 1
        RArr = Split(ReArr(i), "_")
        Cells(i + 16, 1).Value = RArr(0)
        Cells(i + 16, 2).Value = RArr(1)
        Cells(i + 16, 3).Value = RArr(2)
        Cells(i + 16, 4).Value = RArr(3)
        Cells(i + 16, 5).Value = RArr(4)
    Next i
Else
    MsgBox "没有找到符合条件的模具！"
End If

Set Dic = Nothing

End Sub



字典法多条件筛选数据.rar (20.42 KB, 下载次数: 64)

2016-4-23 11:00 上传

点击文件名下载附件