求助：根据单元格条件，自动筛选“条件”行和“空白”行

zyhui1961

要求：
1：在本工作表M3单元格根据“筛选条件”工作表的E3单元格筛选条件，筛选出“单位002”行和“空白”行，达到本工作表效果。
2：当“筛选条件”工作表的E3单元格筛选条件改变时，本表自动相应改变。
谢谢了!

蓝桥玄霜

1. Dim rng As Range, t, Sht As Worksheet
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3. If Target.Address <> "$E$3" Then Exit Sub
   
4. Dim Arr, i&, d
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Set Sht = Sheets("目标文件")
   
7. Sht.Activate
   
8. Arr = Sht.UsedRange
   
9. For i = 4 To UBound(Arr)
   
10.     d(Arr(i, 12)) = d(Arr(i, 12)) & i & ","
    
11. Next
    
12. Sht.Rows(4).Resize(UBound(Arr) - 3).EntireRow.Hidden = True
    
13. If d.exists(Target.Value) Then
    
14.     t = d(Target.Value)
    
15.     Call yy(t)
    
16. End If
    
17. If d.exists("") Then
    
18.     t = d("")
    
19.     Call yy(t)
    
20. End If
    
21. If Not rng Is Nothing Then rng.EntireRow.Hidden = False
    
22. Set rng = Nothing
    
23. End Sub
    

复制代码

蓝桥玄霜

请见附件。

zyhui1961

蓝桥玄霜 发表于 2015-7-19 10:05
请见附件。

这个很好，谢谢版主!

不过我还有问题：如果有多个工作表引用“条件单元格”，又该怎么改代码呢(最好附简单说明，方便我修改代码)?

再次谢谢版主!谢谢了!!!

蓝桥玄霜

1. Dim rng As Range, t, Sht As Worksheet, Arr, col%
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3. If Target.Address <> "$E$3" Then Exit Sub
   
4. Dim i&, d
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. For Each Sht In Sheets
   
7.     If Sht.Name <> "筛选条件" Then
   
8.         Sht.Activate
   
9.         Arr = Sht.UsedRange
   
10.         Call bt(Arr)
    
11.         For i = 4 To UBound(Arr)
    
12.             d(Arr(i, col)) = d(Arr(i, col)) & i & ","
    
13.         Next
    
14.         Sht.Rows(4).Resize(UBound(Arr) - 3).EntireRow.Hidden = True
    
15.         If d.exists(Target.Value) Then
    
16.             t = d(Target.Value)
    
17.             Call yy(t)
    
18.         End If
    
19.         If d.exists("") Then
    
20.             t = d("")
    
21.             Call yy(t)
    
22.         End If
    
23.         If Not rng Is Nothing Then rng.EntireRow.Hidden = False
    
24.         Set rng = Nothing
    
25.         d.RemoveAll
    
26.     End If
    
27. Next
    
28. End Sub
    

复制代码

蓝桥玄霜

请见附件。

zyhui1961

蓝桥玄霜 发表于 2015-7-20 09:58
请见附件。

感谢版主，这个代码很好，非常感谢！！！
可惜我不会改代码！还是用不了！！！

风清云也淡

星光老帅你好！
        我在EXCEL HOME 下了你一个文件：函数的方法，附件参考：   108.rar（发表于：15年09月11日，是回复这个问题的：下拉列表中实现模糊查询）；      我改了一下：是用来计算计件工资，很好用！但我发现一个问题就是当：辅助列超过公式中：189行后（公式就会变成，循环引用），我厂有500多个品种，189行不够用。能不能：把辅助列改到有1000行！           盼复：     我Q：157453118