查詢多筆Excel檔案指定活業簿資料,多筆列出

jackson7015

想跟各位前輩們請教多筆檔案查詢的巨集

小弟有找到一些資料,但是不會整合,希望有大大能幫忙
以下是我找到的此討論版相關的討論
搜尋 Excel檔案、活業簿多筆關鍵字，再多筆"完整"列出
多筆EXCEL搜尋的用法

在下將所需的問題提問於附檔中的工作日報表.xls裡面
小弟才疏學淺,附件中的巨集還在參透中,所以還望其他前輩能幫忙整合
查詢多檔案綜合資料庫.rar (58.67 KB)

下載次數: 18

2012-4-26 09:11

GBKEE

回復 1# jackson7015

1. Option Explicit
   
2. Dim Wb(1 To 2) As Workbook, xlText As String, S As Integer, AR()
   
3. Const 工作簿 = "查詢用"
   
4. Sub 查詢_A() '要查詢資料的活頁簿已開啟
   
5.     主活頁簿
   
6.     For Each Wb(2) In Workbooks                                 '所有開啟的活頁簿
   
7.         If Wb(1).Name <> Wb(2).Name Then 資料查詢
   
8.     Next
   
9.     置入資料
   
10. End Sub
    
11. Sub 查詢_B() '要查詢資料的活頁簿未開啟: 且與主活頁簿在同一資料夾 查詢 "*工作日報表.xls" 活頁簿的資料
    
12.     Dim xlFile As String, xlPath As String
    
13.     主活頁簿
    
14.     xlPath = Wb(1).Path & "\"
    
15.     xlFile = Dir(xlPath & "*工作日報表.xls")
    
16.     Wb(1).Activate
    
17.     Application.ScreenUpdating = False
    
18.     Do While xlFile <> ""
    
19.         If Wb(1).Name <> xlFile Then
    
20.              Set Wb(2) = Workbooks.Open(xlPath & xlFile)
    
21.             資料查詢
    
22.             Wb(2).Close False
    
23.         End If
    
24.         xlFile = Dir
    
25.     Loop
    
26.     置入資料
    
27.     Application.ScreenUpdating = True
    
28. End Sub
    
29. Sub 查詢_C() '要查詢資料的活頁簿未開啟: 用視窗來選起取(指定)資料夾  查詢 "*工作日報表.xls" 活頁簿的資料
    
30.     Dim xlPath As String, xlFile As String
    
31.     主活頁簿
    
32.     With Application.FileDialog(msoFileDialogFolderPicker)
    
33.         .InitialFileName = Wb(1).Path & "\"
    
34.         If .Show = True Then
    
35.             xlPath = .SelectedItems(1) & "\"
    
36.         Else
    
37.             MsgBox "沒有指定 資料夾"
    
38.             Exit Sub
    
39.         End If
    
40.     End With
    
41.     xlFile = Dir(xlPath & "*工作日報表.xls")
    
42.     Wb(1).Activate
    
43.     Application.ScreenUpdating = False
    
44.     Do While xlFile <> ""
    
45.         If Wb(1).Name <> xlFile Then
    
46.              Set Wb(2) = Workbooks.Open(xlPath & xlFile)
    
47.             資料查詢
    
48.             Wb(2).Close False
    
49.         End If
    
50.         xlFile = Dir
    
51.     Loop
    
52.     置入資料
    
53.     Application.ScreenUpdating = True
    
54. End Sub
    
55. Sub 清除資料()
    
56.     With Wb(1).Sheets(工作簿)                                   '程式碼所在的活頁簿
    
57.         .Range("B4").CurrentRegion.Offset(2).Clear              '清除舊有資料
    
58.     End With
    
59. End Sub
    
60. Private Sub 主活頁簿()
    
61.     Set Wb(1) = ThisWorkbook                                    '程式碼所在的活頁簿
    
62.    'Set Wb(1 =Workbooks("工作日報表.xls")                       '在指定的活頁簿
    
63.     xlText = Wb(1).Sheets("查詢用").TextBox1                    '要搜尋的字串
    
64.     S = 0
    
65. End Sub
    
66. Private Sub 資料查詢()
    
67.     Dim E As Range, Ay(), xi As Integer
    
68.     For Each E In Wb(2).Sheets(1).UsedRange.Rows               '已使用範圍的列
    
69.         If (E.Cells(1, 4) <> "" And IsNumeric(E.Cells(1, 4))) And Mid(E.Cells(1, 4), 1, Len(xlText)) = xlText Then       '比對D欄中的字串
    
70.             ReDim Preserve AR(S)                            '重新配置動態陣列變數的儲存空間。
    
71.             'Preserve:選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
    
72.             ReDim Ay(1 To E.Cells.Count)
    
73.             For xi = 1 To E.Cells.Count                   '將比對到的列從第1欄 依序置入陣列
    
74.                 Ay(xi) = E.Cells(1, xi).Text
    
75.             Next
    
76.             AR(S) = Ay
    
77.             S = S + 1                                       '下一個比對到的列 之陣列 元素索引值
    
78.         End If
    
79.     Next
    
80. End Sub
    
81. Private Sub 置入資料()
    
82.     Dim xi As Integer
    
83.     With Wb(1).Sheets(工作簿)                                  '程式碼所在的活頁簿
    
84.         If S > 0 Then
    
85.             .Range("B4").CurrentRegion.Offset(2).Clear                '清除舊有資料
    
86.             For xi = 0 To S - 1
    
87.                 .Range("B5").Offset(xi).Resize(1, UBound(AR(xi))).Value = AR(xi) '依序置入 比對到的列
    
88.                 'UBound 函數 傳回 Long值，表示指定陣列某維最大可使用的陣列索引。
    
89.             Next
    
90.         Else
    
91.             MsgBox "查無 資料"
    
92.         End If
    
93.     End With
    
94. End Sub

複製代碼

jackson7015

回復 2# GBKEE
    先感謝GBKEE版主大大的回應
正在慢慢研究內容中
感謝附上中文說明，讓小弟能逐行觀察學習
先行測試和研究程式碼去
謝謝指教！