暱稱: 隨風飄蕩的羽毛 頭銜: [御用]潛水艇
高中生 
- 帖子
- 852
- 主題
- 79
- 精華
- 0
- 積分
- 918
- 點名
- 0
- 作業系統
- Windows 7 , XP
- 軟體版本
- Office 2007, Office 2003,Office 2010,YoZo Office
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 宇宙
- 註冊時間
- 2011-4-8
- 最後登錄
- 2024-2-21
|
2#
發表於 2011-6-24 08:06
| 只看該作者
回復 1# onegirl0204
你的意思是說
要一個檔案作為 查詢
然後其他檔案作為該 檔案的資料擷取來源???
以下原始碼 為 版大之前所做的 擷取該小段出來....- Private Sub CommandButton1_Click() '此功能按鈕名稱為 查詢
- Sheets("查詢").Select
- '此區為 查詢功能的程式碼
- Sheets("查詢").Select
- Range("A2:cz65535").Clear
- Dim Ar()
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
- With Sheet1
- nd = IIf(OptionButton1 = True, 1, IIf(OptionButton2 = True, 2, IIf(OptionButton3 = True, 3, IIf(OptionButton4 = True, 4, IIf(OptionButton5 = True, 5, IIf(OptionButton6 = True, 6, IIf(OptionButton7 = True, 8, IIf(OptionButton8 = True, 10, IIf(OptionButton9 = True, 12, IIf(OptionButton10 = True, 13, IIf(OptionButton11 = True, 14, IIf(OptionButton12 = True, 15, IIf(OptionButton13 = True, 16, IIf(OptionButton14 = True, 17, IIf(OptionButton15 = True, 25, 0))))))))))))))) '這邊我是用 OPTIONBUTTON當作查詢的選項控制
-
- mystr = "*" & TextBox1 & "*"
- '---此區為判讀
- If nd = 0 Then MsgBox "請選擇查詢項目": Exit Sub
-
- fs = Dir(ThisWorkbook.Path & "\*總表.xls") '這邊改你要的名稱
-
- Do Until fs = ""
-
- With Workbooks.Open(ThisWorkbook.Path & "\" & fs)
-
- For Each Sh In .Sheets
-
- With Sh
-
- If Application.CountA(.Columns(nd)) = 0 Then GoTo 10
-
- For Each a In .Columns(nd).SpecialCells(xlCellTypeConstants)
-
- If a Like mystr Then
-
- ReDim Preserve Ar(S)
-
- Ar(S) = Array(fs, .Name, S + 1, .Cells(a.Row, 1).Value, .Cells(a.Row, 2).Value, .Cells(a.Row, 3).Value, .Cells(a.Row, 4).Value, .Cells(a.Row, 5).Value, .Cells(a.Row, 6).Value, .Cells(a.Row, 7).Value, .Cells(a.Row, 8).Value, .Cells(a.Row, 9).Value, .Cells(a.Row, 10).Value, .Cells(a.Row, 11).Value, .Cells(a.Row, 12).Value, .Cells(a.Row, 13).Value, .Cells(a.Row, 14).Value, .Cells(a.Row, 15).Value, .Cells(a.Row, 16).Value, .Cells(a.Row, 17).Value, .Cells(a.Row, 18).Value, .Cells(a.Row, 19).Value, .Cells(a.Row, 20).Value, .Cells(a.Row, 21).Value, .Cells(a.Row, 22).Value, .Cells(a.Row, 23).Value, .Cells(a.Row, 24).Value, .Cells(a.Row, 25).Value) '這邊是判斷欄位
-
- S = S + 1
- Label1.Caption = " 查詢名稱：" & TextBox1.Text & " ； " & " 查詢的筆數為：" & S & " 筆資料"
- Label2.Caption = "查詢時間：" & Date & " " & Time
- End If
-
- Next
-
- 10
-
- End With
-
- Next
-
- .Close 0
-
- End With
-
- fs = Dir
-
- Loop
-
- If S > 0 Then
-
- .[A2:z65536] = ""
-
- .[A2].Resize(S, 28) = Application.Transpose(Application.Transpose(Ar))
-
- Else
- MsgBox "查無資料"
- End If
- End With
-
- Application.ScreenUpdating = True
- 'ActiveWindow.Close savechanges:=True
- End Sub
|
|
