关于多表格筛选问题

bajifeng

rio123 发表于 2015-12-22 10:02
存在的，就是下载附件直接运行报错的

你昨天给我的附件，只有两个工作表 -》筛选 + 目录

bajifeng

rio123 发表于 2015-12-22 10:02
存在的，就是下载附件直接运行报错的

把你有问题的表格上传一下，我看看。

rio123

bajifeng 发表于 2015-12-22 10:10
把你有问题的表格上传一下，我看看。

04A 多表格筛选(增加目录).rar (37.92 KB, 下载次数: 8)

2015-12-22 10:38 上传

点击文件名下载附件

请见附件

bajifeng

1. Sub bajifeng()    'bajifeng
   
2. 'http://club.excelhome.net/thread-1246855-2-1.html
   
3. Dim brr()
   
4. Application.EnableEvents = False
   
5. Sheets("筛选结果").Activate
   
6. s = [a2] & [b2] & [c2]
   
7. b = IIf([b2] = 0, 0, 1)
   
8. Sheets("筛选结果").UsedRange.Offset(4).Clear
   
9. For Each Sh In Sheets
   
10.     i = 0
    
11.     If InStr(Sh.Name, "筛") = 0 Then
    
12.         If InStr(Sh.Name, "目录") = 0 Then
    
13.             Sh.Activate
    
14.             lr = Sh.[a65536].End(3).Row
    
15.             Debug.Print Sh.Name
    
16.             arr = Sh.Range([a2], Cells(lr, "g"))
    
17.             For i = 1 To UBound(arr)
    
18.                 If b = 1 And InStr(arr(i, 1) & arr(i, 2) & arr(i, 4), s) > 0 Then
    
19.                     n = n + 1
    
20.                     ReDim Preserve brr(1 To 7, 1 To n)
    
21.                     For j = 1 To 7
    
22.                         brr(j, n) = arr(i, j)
    
23.                     Next
    
24.                 ElseIf b = 0 And InStr(arr(i, 1) & arr(i, 4), s) > 0 Then
    
25.                     n = n + 1
    
26.                     ReDim Preserve brr(1 To 7, 1 To n)
    
27.                     For j = 1 To 7
    
28.                         brr(j, n) = arr(i, j)
    
29.                     Next
    
30.                 End If
    
31.             Next
    
32.         End If
    
33.     End If
    
34. Next
    
35. Sheets("筛选结果").Activate
    
36. [a5:g5].Resize(UBound(brr, 2)) = Application.Transpose(brr)
    
37. Application.EnableEvents = True
    
38. End Sub

复制代码

bajifeng

>>>>>>>>>>>>>>>>>>>

rio123

bajifeng 发表于 2015-12-22 10:52
>>>>>>>>>>>>>>>>>>>

如果有其他表格超过7列的内容需要提取，应该改代码的哪个位置？我有一个14列的表格要提取，把7改成14后报错

bajifeng

还需要。。arr = Sh.Range([a2], Cells(lr, "g")) 把 G 改成相应的列数

rio123

bajifeng 发表于 2015-12-22 11:24
还需要。。arr = Sh.Range([a2], Cells(lr, "g")) 把 G 改成相应的列数

非常感谢您的帮助

wanwei930914

bajifeng 发表于 2015-12-22 11:24
还需要。。arr = Sh.Range([a2], Cells(lr, "g")) 把 G 改成相应的列数

好多年前的帖子了不知道您是否还会回复

我遇到一个相似的问题想请教一下，如果这四个工作表改成了很多家子公司四个季度的营业情况汇总，比如说A表里有某公司的一季度情况，B表就有这个公司二季度的情况，以此类推。但是每个工作表下的列数不相同，能否根据搜索一个公司名称，把四个季度的情况在查询页面的同一行里显示或者在某一个区域里显示呢。如果可以的话这个代码要怎么改。