同时筛选多个数据

brianlong

要筛选的数据在第三列，同时筛选多个数据，要筛选的数据以输入框的内容决定。编码的前面5位都是一样的，能否做到只输入后面三位

brianlong

为啥我的求助帖子没有大侠回呢，这次我一定不会吝惜我的花花的

lsc900707

brianlong 发表于 2018-8-2 17:54
为啥我的求助帖子没有大侠回呢，这次我一定不会吝惜我的花花的

输入框在哪里？又是源数据区域筛选？

lsc900707

brianlong 发表于 2018-8-2 17:54
为啥我的求助帖子没有大侠回呢，这次我一定不会吝惜我的花花的

参考4楼代码：
请问怎么输入数据就可以进行筛选
http://club.excelhome.net/thread-1428257-1-1.html
(出处: ExcelHome技术论坛)

lsc900707

brianlong 发表于 2018-8-2 17:54
为啥我的求助帖子没有大侠回呢，这次我一定不会吝惜我的花花的

这样的筛选可以接受吗？

brianlong

lsc900707 发表于 2018-8-2 18:13
这样的筛选可以接受吗？

你好  我把代码套进去  怎么只有一个单号呢  麻烦帮我指正一下

lsc900707

brianlong 发表于 2018-8-2 20:28
你好  我把代码套进去  怎么只有一个单号呢  麻烦帮我指正一下

代码没错。没有3475这个单号的信息呀！

brianlong

brianlong 发表于 2018-8-2 20:28
你好  我把代码套进去  怎么只有一个单号呢  麻烦帮我指正一下

好尴尬，我输错了

brianlong

lsc900707 发表于 2018-8-2 21:33
代码没错。没有3475这个单号的信息呀！

今天套了代码后，在测试的时候发现如果单号只有一个的时候会报错。应该是第二个数组只有一个 元素是循环就出错了。所以筛选就分了两种情况。一种是单号只有一个，另外一种就是单号有N个

lsc900707

brianlong 发表于 2018-8-3 20:41
今天套了代码后，在测试的时候发现如果单号只有一个的时候会报错。应该是第二个数组只有一个 元素是循环 ...

我的理解是你要筛选多个单号呢。如果是两种情况都可能的话，修改一下：

1. Sub u()
   
2.     Dim crr(1 To 2000, 1 To 14)
   
3.     arr = Range([a1], Cells(Rows.Count, 14).End(3))
   
4.     r = Cells(Rows.Count, "p").End(3).Row
   
5.     brr = Range("p1:p" & r)
   
6.     For i = 2 To UBound(arr)
   
7.         If r < 2 Then
   
8.             If InStr(arr(i, 5), [p1]) Then
   
9.                 m = m + 1
   
10.                 For j = 1 To 14
    
11.                     crr(m, j) = arr(i, j)
    
12.                 Next
    
13.             End If
    
14.         Else
    
15.             For k = 1 To UBound(brr)
    
16.                 If InStr(arr(i, 5), brr(k, 1)) Then
    
17.                     m = m + 1
    
18.                     For j = 1 To 14
    
19.                         crr(m, j) = arr(i, j)
    
20.                    Next
    
21.                 End If
    
22.              Next
    
23.         End If
    
24.     Next
    
25.     If m Then
    
26.         Sheet2.Cells.ClearContents
    
27.         Sheet2.[a2].Resize(m, 14) = crr
    
28.    End If
    
29. End Sub

复制代码