[已解决]多条件查找引用问题

fggf

请大侠们帮我写下公式或代码，感激不尽
多条件查找引用问题.rar (15.16 KB, 下载次数: 19)

2016-5-12 10:44 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-13 11:12

条件2只要判断>=，要简单很多。

1. Sub 筛选()
   
2.     Dim 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.         ok3 = False
    
11.         If tj1 = "" Or arr(i, 3) Like "*" & tj1 & "*" Then     '条件1满足
    
12.             If tj2 = "" Or arr(i, c) >= tj2 Then  '条件2满足
    
13.                 If tj3 = "" Then
    
14.                     If arr(i, 8) = "三好学生" And arr(i, 9) = "三好学生" Then ok3 = True
    
15.                 Else
    
16.                     If arr(i, c1) = "三好学生" Then ok3 = True
    
17.                 End If
    
18.                 If ok3 Then
    
19.                     n = n + 1
    
20.                     brr(n, 1) = arr(i, 3)
    
21.                     brr(n, 2) = arr(i, c)
    
22.                     brr(n, 3) = "三好学生"
    
23.                 End If
    
24.             End If
    
25.         End If
    
26.     Next
    
27.     [b8:d1000] = ""
    
28.     If n = 0 Then
    
29.         MsgBox "查无此信息"
    
30.     Else
    
31.         [b8].Resize(n, 3) = brr
    
32.     End If
    
33. End Sub
    

复制代码

跳转到最佳答案楼层

fggf

谁帮忙看看下

dsmch

源数据稍微修改一下行标题格式，自己用高级筛选就轻松搞定了

yangkongsong

学习一下！

grf1973

条件2只要判断>=，要简单很多。

1. Sub 筛选()
   
2.     Dim 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.         ok3 = False
    
11.         If tj1 = "" Or arr(i, 3) Like "*" & tj1 & "*" Then     '条件1满足
    
12.             If tj2 = "" Or arr(i, c) >= tj2 Then  '条件2满足
    
13.                 If tj3 = "" Then
    
14.                     If arr(i, 8) = "三好学生" And arr(i, 9) = "三好学生" Then ok3 = True
    
15.                 Else
    
16.                     If arr(i, c1) = "三好学生" Then ok3 = True
    
17.                 End If
    
18.                 If ok3 Then
    
19.                     n = n + 1
    
20.                     brr(n, 1) = arr(i, 3)
    
21.                     brr(n, 2) = arr(i, c)
    
22.                     brr(n, 3) = "三好学生"
    
23.                 End If
    
24.             End If
    
25.         End If
    
26.     Next
    
27.     [b8:d1000] = ""
    
28.     If n = 0 Then
    
29.         MsgBox "查无此信息"
    
30.     Else
    
31.         [b8].Resize(n, 3) = brr
    
32.     End If
    
33. End Sub
    

复制代码