[已解决]修改代码——关于筛选的精确/模糊查找

文轩馨婷

与其说是修改代码，还不如说是求助编写代码（因为我也是在度娘哪里抄来的——而且没起到作用）

望：各位前辈们不吝赐教！！——有更好的模本我照样全收！

在此先谢过了！

要求：1.A1:E2是高级筛选的条件区
2.如何在B2：E2区域中填入需查找的“编码/名称/通知书号/出货日期”既可精确查找又可模糊查找并且查到的数据直接筛选在下面——查找的对象是“北海出货明细”


Sub 查询筛选()
Dim Erow, ce
With Sheets("查询筛选")
    Erow = Sheets("北海出货明细").[a65536].End(xlUp).Row
    .Range("a4:h65536").ClearContents
    For Each ce In .[b2:e2]
        If ce <> "" Then ce.Value = "*" & ce & "*"   '加上通配符*,实现模糊查询
    Next
    Sheets("北海出货明细").Range("A1:H" & Erow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    .[a1:h1], CopyToRange:=.[A4], Unique:=False
    For Each ce In .[b2:e2]
        If ce <> "" Then ce.Value = Mid(ce, 2, Len(ce) - 2)   '取消 "*"通配符
    Next
End With
End Sub

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2014-6-26 21:45

你试试

1. Sub aaa()
   
2. Dim j&
   
3. Range("a5:h" & [a65536].End(3).Row + 1).Clear
   
4. With Sheets("北海出货明细")
   
5.   If Cells(2, 5) <> "" Then .UsedRange.AutoFilter Field:=1, Criteria1:=Cells(2, 5).Value Else .UsedRange.AutoFilter Field:=1
   
6.   For j = 2 To 4
   
7.     If Cells(2, j) <> "" Then .UsedRange.AutoFilter Field:=j, Criteria1:="*" & Cells(2, j) & "*" Else .UsedRange.AutoFilter Field:=j
   
8.   Next j
   
9.   .UsedRange.Offset(1).Copy [a5]
   
10.   .UsedRange.AutoFilter
    
11. End With
    
12. End Sub

复制代码

跳转到最佳答案楼层

文轩馨婷

一般情况————2楼一直都是本人的！！

{:1112:}{:1112:}{:1112:}{:1112:}

文轩馨婷

{:251:}{:251:}{:251:}{:091:}

大灰狼1976

应该很简单,但是看画面我的2003版打不开,上传个2003版的上来吧.

文轩馨婷

大灰狼1976 发表于 2014-6-26 20:46
应该很简单,但是看画面我的2003版打不开,上传个2003版的上来吧.

我这个可以用2003打开的

大灰狼1976

你试试

1. Sub aaa()
   
2. Dim j&
   
3. Range("a5:h" & [a65536].End(3).Row + 1).Clear
   
4. With Sheets("北海出货明细")
   
5.   If Cells(2, 5) <> "" Then .UsedRange.AutoFilter Field:=1, Criteria1:=Cells(2, 5).Value Else .UsedRange.AutoFilter Field:=1
   
6.   For j = 2 To 4
   
7.     If Cells(2, j) <> "" Then .UsedRange.AutoFilter Field:=j, Criteria1:="*" & Cells(2, j) & "*" Else .UsedRange.AutoFilter Field:=j
   
8.   Next j
   
9.   .UsedRange.Offset(1).Copy [a5]
   
10.   .UsedRange.AutoFilter
    
11. End With
    
12. End Sub

复制代码

大灰狼1976

第9句代码稍加修改,有时候偷懒真不是好习惯

1. Sub aaa()
   
2. Dim j&
   
3. Range("a5:h" & [a65536].End(3).Row + 1).Clear
   
4. With Sheets("北海出货明细")
   
5.   If Cells(2, 5) <> "" Then .UsedRange.AutoFilter Field:=1, Criteria1:=Cells(2, 5).Value Else .UsedRange.AutoFilter Field:=1
   
6.   For j = 2 To 4
   
7.     If Cells(2, j) <> "" Then .UsedRange.AutoFilter Field:=j, Criteria1:="*" & Cells(2, j) & "*" Else .UsedRange.AutoFilter Field:=j
   
8.   Next j
   
9.   .Range("a2:h" & .[a65536].End(3).Row).Copy [a5]
   
10.   .UsedRange.AutoFilter
    
11. End With
    
12. End Sub

复制代码

文轩馨婷

大灰狼1976 发表于 2014-6-26 21:45
你试试

老师，
   您录制Macro2这个宏的作用是什么？

大灰狼1976

录制这个宏的原因是，比较惭愧，很多简单的功能因为实在太简单了，反而我不会去记代码，
用的时候录制个宏看一下，嗯，就是这样，没有其他原因，你可以删除它。

文轩馨婷

大灰狼1976 发表于 2014-6-27 21:47
录制这个宏的原因是，比较惭愧，很多简单的功能因为实在太简单了，反而我不会去记代码，
用的时候录制个宏 ...

等于就是——如果我要借鉴到其它表中只需代码就行了咯