在多表中查询想要的数据

lczzzzzzz

我有四张表，一张有"面板"和"查询结果"两张子表，另三张是数据表，当然可能有更多张数据表，但数据表的字段相同，表名有固定规则。我想在面板中输入城市名称，点击确定后，便在查询结果表中显示与该城市有关的数据，并存放在查询结果中。因为数据表我会越积累越多，并存放在一个文件夹中，目的是要找到数据曾经在哪张表中出现过。

问题在"总表"中找，多谢了。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr(1 To 1000, 1 To 3)
   
4.   Dim wb As Workbook
   
5.   Dim ws As Worksheet
   
6.   Dim mypath$, myname$
   
7.   Application.ScreenUpdating = False
   
8.   Application.DisplayAlerts = False
   
9.   With Worksheets("面板")
   
10.     city = .Range("b4")
    
11.   End With
    
12.   mypath = ThisWorkbook.Path & ""
    
13.   myname = Dir(mypath & myname)
    
14.   Do While myname <> ""
    
15.     If myname <> ThisWorkbook.Name Then
    
16.       Set wb = GetObject(mypath & myname)
    
17.       With wb
    
18.         With .Worksheets(1)
    
19.           r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
20.           arr = .Range("a2:c" & r)
    
21.           For i = 1 To UBound(arr)
    
22.             If arr(i, 2) = city Or arr(i, 3) = city Then
    
23.               m = m + 1
    
24.               brr(m, 1) = Split(myname, ".")(0)
    
25.               brr(m, 2) = arr(i, 2)
    
26.               brr(m, 3) = arr(i, 3)
    
27.             End If
    
28.           Next
    
29.         End With
    
30.         .Close False
    
31.       End With
    
32.     End If
    
33.     myname = Dir
    
34.   Loop
    
35.   With Worksheets("查询结果")
    
36.     .UsedRange.Offset(1, 0).Clear
    
37.     .Range("a2").Resize(m, UBound(brr, 2)) = brr
    
38.   End With
    
39. End Sub
    

复制代码

lczzzzzzz

chxw68 发表于 2019-1-22 21:15

我看一下，多谢了……

everbest2015

Private Sub CommandButton1_Click()
     Dim path$, myfile$, wkb As Workbook, ar(), i&, s$, sr$, sh As Worksheet
     Dim br, m&, k&, n&
    s = ThisWorkbook.Worksheets("面板").[B4]
    path = ThisWorkbook.path & "\"
    myfile = Dir(path & "*.xls*")
    Application.ScreenUpdating = True
                Do While myfile <> ""
                    If myfile <> ThisWorkbook.Name Then
                        Set wkb = GetObject(path & myfile)
                        With wkb
                             sr = Left(.Name, InStr(.Name, ".") - 1)
                            Set sh = .Sheets(1)
                            n = sh.Range("a" & sh.Rows.Count).End(xlUp).Row
                            br = sh.Range("a1:c" & n)
                            For m = 2 To UBound(br)
                                If br(m, 2) = s Or br(m, 3) = s Then
                                    k = k + 1
                                    ReDim Preserve ar(1 To 3, 1 To k)
                                    ar(1, k) = sr
                                    ar(2, k) = br(m, 2)
                                    ar(3, k) = br(m, 3)
                                End If
                            Next
                            .Close False
                        End With
                    End If
                    myfile = Dir
                Loop
    Application.ScreenUpdating = True
                If k > 0 Then
                            With ThisWorkbook.Worksheets("查询结果")
                                .Range("a2:c10000") = ""
                                .Range("a2").Resize(k, 3) = Application.Transpose(ar)
                             End With
                             MsgBox "你好,共查询到" & k & "条满足条件的记录", , "新年快乐"
                Else
                    MsgBox "不存在您要查询的城市名称", vbExclamation, "请核实": Exit Sub
                End If
                Erase ar: Erase br
End Sub

everbest2015

请测试附件内容

lczzzzzzz

everbest2015 发表于 2019-1-22 22:37
请测试附件内容

多谢多谢！！！

lczzzzzzz

everbest2015 发表于 2019-1-22 22:37
请测试附件内容

实际工作中，我的数据表是.csv格式，所以城市名称中含有很多字符，能不能用模糊查询的方式解决，怎么解决？多谢！