设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 条件筛选问题
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2621|回复: 7

[已解决]条件筛选问题

[复制链接]
fggf
发表于 2016-5-10 22:21 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 fggf 于 2016-5-11 18:11 编辑

按列好的条件筛选出所要的内容，如附件，麻烦各位大侠帮忙下 条件筛选1.rar (15.01 KB, 下载次数: 7)
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
fggf
 楼主| 发表于 2016-5-11 18:09 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
顶上，谁帮我解决下啊
回复

使用道具 举报

grf1973
发表于 2016-5-13 11:02 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
  1. Sub 筛选()
  2.     Dim ok2 As Boolean, ok3 As Boolean
  3.     km = [c4] & [d4]  '科目
  4.     c = IIf(km = "上学期语文", 4, IIf(km = "上学期数学", 5, IIf(km = "下学期语文", 6, 7)))
  5.     tj1 = [b4]: tj2 = [e4]: tj3 = [f4]
  6.     c1 = IIf(tj3 = "上学期", 8, 9)
  7.     arr = Sheet1.[a1].CurrentRegion
  8.     ReDim brr(1 To UBound(arr), 1 To 3)
  9.     For i = 3 To UBound(arr)
  10.         ok2 = False: ok3 = False
  11.         If tj1 = "" Or arr(i, 3) Like "*" & tj1 & "*" Then     '条件1满足
  12.             fs = arr(i, c)   '指定科目的分数
  13.             If tj2 = "" Then
  14.                 ok2 = True
  15.             Else                 '条件2为：分数>=（>,<=,<）分数线类型，需分别判断
  16.                 For k = 1 To Len(tj2)      '找出分数线
  17.                     If IsNumeric(Mid(tj2, k, 1)) Then Exit For
  18.                 Next
  19.                 fsx = Val(Mid(tj2, k)) '分数线
  20.                 If InStr(tj2, ">=") > 0 Then
  21.                     ok2 = CBool(fs >= fsx)
  22.                 ElseIf InStr(tj2, ">") > 0 Then
  23.                     ok2 = CBool(fs > fsx)
  24.                 ElseIf InStr(tj2, "<=") > 0 Then
  25.                     ok2 = CBool(fs <= fsx)
  26.                 ElseIf InStr(tj2, "<") > 0 Then
  27.                     ok2 = CBool(fs < fsx)
  28.                 End If
  29.             End If
  30.             If ok2 = True Then   '条件2满足
  31.                 If tj3 = "" Then
  32.                     If arr(i, 8) = "三好学生" And arr(i, 9) = "三好学生" Then ok3 = True
  33.                 Else
  34.                     If arr(i, c1) = "三好学生" Then ok3 = True
  35.                 End If
  36.                 If ok3 Then
  37.                     n = n + 1
  38.                     brr(n, 1) = arr(i, 3)
  39.                     brr(n, 2) = arr(i, c)
  40.                     brr(n, 3) = "三好学生"
  41.                 End If
  42.             End If
  43.         End If
  44.     Next
  45.     [b8:d1000] = ""
  46.     If n = 0 Then
  47.         MsgBox "查无此信息"
  48.     Else
  49.         [b8].Resize(n, 3) = brr
  50.     End If
  51. End Sub
复制代码

条件筛选1.rar

28.35 KB, 下载次数: 3
回复

使用道具 举报

grf1973
发表于 2016-5-13 11:05 | 显示全部楼层
1、姓名支持模糊筛选，比较输入”吴“，可查出所有带”吴“的项
2、三好学生下面只有”上学期“”下学期“和空值，默认空值是上下学期都是三好学生（其实觉得应该有四个选项：”上学期“”下学期“”上下学期“”非三好生“
3、分数支持>=,>,<=,<四种类型判断（应该没必要放<>）
回复

使用道具 举报

fggf
 楼主| 发表于 2016-5-13 18:38 | 显示全部楼层
grf1973 发表于 2016-5-13 11:05
1、姓名支持模糊筛选，比较输入”吴“，可查出所有带”吴“的项
2、三好学生下面只有”上学期“”下学期“ ...

太强了[em17]，非常感谢！您的建议非常好。
能再帮我修改下吗？
第三个条件为空时不默认为两个学期都是“三好学生”。

现在要达到的效果是：
在第二个条件永不为空的情况下：
1、若第一条件为空时，则按二、三条件查找符合项；
2、若第一条件和第三条件都为空时，则只按二条件查找符合项；
3、若第三条件为空时，则按一、二条件查找符合项。
4、保留建议的>，<，或“<="等
回复

使用道具 举报

grf1973
发表于 2016-5-16 09:24 | 显示全部楼层    本楼为最佳答案   
这样更简单一点。
  1. Sub 筛选()
  2.     Dim ok2 As Boolean, ok3 As Boolean
  3.     km = [c4] & [d4]  '科目
  4.     c = IIf(km = "上学期语文", 4, IIf(km = "上学期数学", 5, IIf(km = "下学期语文", 6, 7)))
  5.     tj1 = [b4]: tj2 = [e4]: tj3 = [f4]
  6.     c1 = IIf(tj3 = "上学期", 8, 9)
  7.     arr = Sheet1.[a1].CurrentRegion
  8.     ReDim brr(1 To UBound(arr), 1 To 3)
  9.     For i = 3 To UBound(arr)
  10.         ok2 = False: ok3 = False
  11.         If tj1 = "" Or arr(i, 3) Like "*" & tj1 & "*" Then     '条件1满足
  12.             fs = arr(i, c)   '指定科目的分数
  13.             If tj2 = "" Then
  14.                 ok2 = True
  15.             Else                 '条件2为：分数>=（>,<=,<）分数线类型，需分别判断
  16.                 For k = 1 To Len(tj2)      '找出分数线
  17.                     If IsNumeric(Mid(tj2, k, 1)) Then Exit For
  18.                 Next
  19.                 fsx = Val(Mid(tj2, k)) '分数线
  20.                 If InStr(tj2, ">=") > 0 Then
  21.                     ok2 = CBool(fs >= fsx)
  22.                 ElseIf InStr(tj2, ">") > 0 Then
  23.                     ok2 = CBool(fs > fsx)
  24.                 ElseIf InStr(tj2, "<=") > 0 Then
  25.                     ok2 = CBool(fs <= fsx)
  26.                 ElseIf InStr(tj2, "<") > 0 Then
  27.                     ok2 = CBool(fs < fsx)
  28.                 End If
  29.             End If
  30.             If ok2 = True Then   '条件2满足
  31.                 If tj3 = "" Then
  32.                     ok3 = True: c1 = 8     '条件3为空时，默认显示第8列
  33.                 ElseIf arr(i, c1) = "三好学生" Then
  34.                     ok3 = True
  35.                 End If
  36.                 If ok3 Then
  37.                     n = n + 1
  38.                     brr(n, 1) = arr(i, 3)
  39.                     brr(n, 2) = arr(i, c)
  40.                     brr(n, 3) = arr(i, c1)
  41.                 End If
  42.             End If
  43.         End If
  44.     Next
  45.     [b8:d1000] = ""
  46.     If n = 0 Then
  47.         MsgBox "查无此信息"
  48.     Else
  49.         [b8].Resize(n, 3) = brr
  50.     End If
  51. End Sub
复制代码

条件筛选1.rar

27.92 KB, 下载次数: 9
回复

使用道具 举报

fggf
 楼主| 发表于 2016-5-16 19:21 | 显示全部楼层
grf1973 发表于 2016-5-16 09:24
这样更简单一点。

老师，你好！再麻烦您下！
如果我想把找出来的项按照分数列从高到低依次显示，要怎么修改呢？
回复

使用道具 举报

grf1973
发表于 2016-5-19 09:26 | 显示全部楼层
加一句话就行了。

条件筛选1.rar

28.3 KB, 下载次数: 5
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-27 08:44 , Processed in 0.334354 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表