多表格的 条件查询代码写了一半，搞不定了。

PP不吃香菜

新手小白， 需要弄一个多表格查询工具，从网上半抄半改的 搞不定了。。。。。所以来求助下。


需要 在查询SHEET中 C2单元格位置输入 省份  。 C3输入   是否异常数据  （是或否） 但 这2个 不是必填项，可以2个都填，也可以只填一个。

非查询SHEET 的 所有SHEET进行按条件查询 （需要查询的表格 是否异常数据 在A列  省份在B列，其它列内容不固定 ）

从第六行开始写入表头

2 因为每个表格 的列不固定  表头可能也不一样， 只有AB列是固定的，所以 需要用拼接的方式  要有表头，需要把表头的颜色带过去方便查看）

求大家帮忙

小凡、、、

不建议这样把表头行带进去，可以最前方多加一列写sheet名，按这个逻辑你应该能写出来

ynzsvt

列号2才是省份。

PP不吃香菜

小凡、、、 发表于 2024-8-13 16:05
不建议这样把表头行带进去，可以最前方多加一列写sheet名，按这个逻辑你应该能写出来

我觉得前方多加一列写sheet名 是对的。，但是 我真心不会。。。每个表的列不一样呀 所以。。。我还是觉得 要带表头的。。

醉眼看尘世

1. Sub test()
   
2. Dim sH As Worksheet, sH1 As Worksheet, i&, j&, Arr, mRow&, SFstr$, zTstr$, jL&
   
3. Set sH1 = Worksheets("查询")
   
4. With sH1
   
5.     mRow = .UsedRange.Rows.Count
   
6.     If mRow > 5 Then .Rows("6:" & mRow).Delete
   
7.     SFstr = .[c2]
   
8.     zTstr = .[c3]
   
9.     If SFstr = "" Or zTstr = "" Then Exit Sub
   
10. End With
    
11. For Each sH In Worksheets
    
12.     With sH
    
13.         If .Name <> sH1.Name Then
    
14.             Arr = .[a1].CurrentRegion
    
15.             jL = 0
    
16.             ReDim brr(1 To UBound(Arr, 1) + 1, 1 To UBound(Arr, 2))
    
17.             For i = 1 To UBound(Arr, 1)
    
18.                 If Arr(i, 1) = zTstr And Arr(i, 2) = SFstr Then
    
19.                     jL = jL + 1
    
20.                     For j = 1 To UBound(Arr, 2)
    
21.                         brr(jL, j) = Arr(i, j)
    
22.                     Next j
    
23.                 End If
    
24.             Next i
    
25.             If jL Then
    
26.                 With sH1
    
27.                     mRow = .Cells(.Rows.Count, "A").End(3).Row
    
28.                     If mRow <= 5 Then mRow = 6 Else mRow = mRow + 1
    
29.                     .Cells(mRow, 1).Resize(1, UBound(Arr, 2)) = Arr
    
30.                     .Cells(mRow, 1).Resize(1, UBound(Arr, 2)).Interior.Color = 12874308
    
31.                     .Cells(mRow + 1, 1).Resize(jL, UBound(brr, 2)) = brr
    
32.                 End With
    
33.             End If
    
34.         End If
    
35.     End With
    
36. Next
    
37. sH1.UsedRange.EntireColumn.AutoFit
    
38. MsgBox "Done!"
    
39. End Sub

复制代码

PP不吃香菜

ynzsvt 发表于 2024-8-13 16:16
列号2才是省份。

请问如果 需要把表头加上 是改哪句。。。

ynzsvt

PP不吃香菜 发表于 2024-8-13 16:38
请问如果 需要把表头加上 是改哪句。。。

刚刚在3楼更新了附件。

小凡、、、

PP不吃香菜 发表于 2024-8-13 16:28
我觉得前方多加一列写sheet名 是对的。，但是 我真心不会。。。每个表的列不一样呀 所以。。。我还是觉得 ...

你要带表头格式的话，不用写入数组，用筛选复制粘贴

PP不吃香菜

ynzsvt 发表于 2024-8-13 16:42
刚刚在3楼更新了附件。

还把SHEET名加上了 太感谢了。

PP不吃香菜

小凡、、、 发表于 2024-8-13 16:44
你要带表头格式的话，不用写入数组，用筛选复制粘贴

文档可以发下 学习学习么。