多表格符合要求点筛选提取整行数据

漠然然然

如附件，如何跨表格实现筛选，生成新表格呢？单条件筛选与多条件 多表格按条件整行提取.rar (26.69 KB, 下载次数: 8)

2023-7-25 13:59 上传

点击文件名下载附件
附件

筛选。

wdy895

建议使用pq进行合并，处理后是这个样子。

漠然然然

wdy895 发表于 2023-7-25 14:33
建议使用pq进行合并

是安装插件吗？

漠然然然

Sub 提取数据()
On Error Resume Next
Dim wsh As Worksheet, i As Integer, brr(), j As Integer, arr
For Each wsh In Worksheets
If wsh.Name = "提取数据" Then GoTo 100
j = wsh.Range("a65536").End(xlUp).Row
arr = wsh.Range("a5:n" & j)
k = k + UBound(arr)
ReDim Preserve brr(1 To 14, 1 To k)
For i = 1 To UBound(arr)
If arr(i, 13) = "不限" Then
n = n + 1
brr(1, n) = arr(i, 1)
brr(2, n) = arr(i, 2)
brr(3, n) = arr(i, 3)
brr(4, n) = arr(i, 4)
brr(5, n) = arr(i, 5)
brr(6, n) = arr(i, 6)
brr(7, n) = arr(i, 7)
brr(8, n) = arr(i, 8)
brr(9, n) = arr(i, 9)
brr(10, n) = arr(i, 10)
brr(11, n) = arr(i, 11)
brr(12, n) = arr(i, 12)
brr(13, n) = arr(i, 13)
brr(14, n) = arr(i, 14)
End If
Next
100:
Next
Sheets("提取数据").Range("a2").Resize(n, 14) = Application.WorksheetFunction.Transpose(brr)
End Sub
其他地方看到的，可以用吗？该怎么修改呢

wdy895

漠然然然 发表于 2023-7-25 14:45
是安装插件吗？

哦豁，你是WPS，好像不支持PQ,要office2010及以上版本才支持，只有看哈群里的大师些与没有其他办法咯。