|
從有關的工作簿中取值有多種方法，現將網上收集的整理向大家共享。
方法 1、使用公式 方法 2、使用 GetObject 函數 、 方法 3、隱藏 Application 對象 方法 4、使用 ExecuteExcel4Macro 方法
方法 5、使用 SQL 連接 1、使用公式 、 如果需要引用的數據不是太多，可以使用公式取得引用工作簿中的工作表數據，如下面的代碼所示。
Sub CopyData_1() Dim Temp As String
Temp = "'" & ThisWorkbook.Path & "￥[數據表.xls]Sheet1'!"
With Sheet1.Range("A1:F22")
.FormulaR1C1 = "=" & Temp & "RC"
.Value = .Value
End With
End Sub 代碼解析： CopyData_1 過程在工作表中寫入公式引用“數據表”中同一位置單元格中的數據。 第 3 行代碼將引用工作簿的路徑賦給變量 Temp。 第 5 行代碼在作表中寫入公式引用數據。 第 6 行代碼將公式轉換為數值。 2、使用 GetObject 函數 、
使用 GetObject 函數來獲取對指定的 Excel 工作表的引用，如下面的代碼所示。 Sub CopyData_2() Dim Wb As Workbook
Dim Temp As String
Application.ScreenUpdating = False
Temp = ThisWorkbook.Path & "￥數據表.xls"
Set Wb = GetObject(Temp)
With Wb.Sheets(1).Range("A1").CurrentRegion
Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value Wb.Close False
End With
Set Wb = Nothing
Application.ScreenUpdating = True
End Sub 代碼解析： CopyData_2 過程使用 GetObject 函數來獲取“數據表”工作簿中的數據。 第 4 行代碼關關屏幕更新加快運行速度。 第 5 行代碼將引用工作簿的路徑賦給變量 Temp。 第 6 行代碼使用 Set 語句將 GetObject 函數返回的對象賦給對象變量 Wb。 GetObject 函數返回文件中的 ActiveX 對象的引用，語法如下：
GetObject([pathname] [, class])
參數 pathname 是可選的，包含待檢索對象的文件的全路徑和名稱。如果省略，則 class 參數是必需的。
參數 class 是可選的，代表該對象的類的字符串。 Class 參數的格式為 appname.objecttype，語法的各個部分如表格 1 所示。
部分 描述
appname 必需的，提供該對象的應用程序名稱。 objecttype 必需的，待創建對象的類型或類。
表格 1 Class 參數語法的各個部分 第 7 行到第 10 行代碼，當 GetObject 函數指定的對象被激活之后，就可以在代碼中使用對象變量 Wb 來訪問這個對象的屬性 和方法。 其中第 7、8 行代碼將“數據表”工作簿中的第 1 張工作表已使用區域的數據賦給本工作表的單元格，第 9 行代碼關關“數據表”工 作簿，使用 GetObject 函數返回對象的引用時，雖然在窗口中看不到對象的實例，但實際上是打開的，所以需用 Close 語句將 其關關。 第 12 行代碼開啟屏幕更新。
3、隱藏 Application 對象 通過隱藏 Application 對象來模擬不打開工作簿取數，如下面的代碼所示。
Sub CopyData_3() Dim myApp As New Application
Dim Sh As Worksheet Dim Temp As String T
emp = ThisWorkbook.Path & "￥數據表.xls"
myApp.Visible = False
Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)
With Sh.Range("A1").CurrentRegion
Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
End With
myApp.Quit
Set Sh = Nothing
Set myApp = Nothing
End Sub 代碼解析： CopyData_3 過程隱藏 Application 對象來模擬不打開工作簿取數。 第 2 行代碼使用 New 關鍵字隱式地創建一個 Application 對象。 第 6 行代碼將新創建的 Application 對象的 Visible 屬性設置為 False，使之隱藏。 第 7 行代碼使用 Open 方法打開“數據表”工作簿（關于 Open 方法請參閱技巧 42 ，因為工作簿是使用新創建的、隱藏的 Application 對象打開的，所以在窗口中是不可視的。 第 8 行到第 10 行代碼將“數據表”工作簿中的第 1 張工作表已使用區域的數據賦給本工作表的單元格。 第 11 行代碼使用 Quit 方法退出新打開的 Excel 程序。 4、使用 ExecuteExcel4Macro 方法 使用 ExecuteExcel4Macro 方法可以做到不打開工作簿的情況下獲取其他工作薄中指定工作表的數據，如下面的代碼所示。
Sub CopyData_4() Dim RCount As Long
Dim CCount As Long
Dim Temp As String
Dim Temp1 As String
Dim Temp2 As String
Dim Temp3 As String
Dim R As Long
Dim C As Long Dim arr() As Variant
Temp = "'" & ThisWorkbook.Path & "￥[數據表.xls]Sheet1'!"
Temp1 = Temp & Rows(1).Address(, , xlR1C1)
Temp1 = "Counta(" & Temp1 & ")"
CCount = Application.ExecuteExcel4Macro(Temp1)
Temp2 = Temp & Columns("A").Address(, , xlR1C1)
Temp2 = "Counta(" & Temp2 & ")"
RCount = Application.ExecuteExcel4Macro(Temp2)
ReDim arr(1 To RCount, 1 To CCount)
For R = 1 To RCount
For C = 1 To CCount
Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)
arr(R, C) = Application.ExecuteExcel4Macro(Temp3)
Next
Next Range("A1").Resize(RCount, CCount).Value = arr
End Sub 代碼解析： CopyData_4 過程使用 ExecuteExcel4Macro 方法獲取“數據表”工作薄中指定工作表的數據。 第 14、16 行代碼使用 ExecuteExcel4Macro 方法執行 Counta 函數取得“數據表”工作薄中指定工作表的行數和列數合計。 ExecuteExcel4Macro 方法執行一個 Microsoft Excel 4.0 宏函數，然后返回此函數的結果，語法如下： expression.ExecuteExcel4Macro(String) 參數 expression 是可選的，返回一個 Application 對象。 參數 String 是必需的，一個不帶等號的 Microsoft Excel 4.0 宏語言函數，所有引用必須是像 R1C1 這樣的字符串。 因為 Microsoft Excel 4.0 宏不在當前工作簿或工作表的環境中求值，所有的引用都是外部引用，所以無需打開引用工作簿但是 需要明確指定工作簿名稱。 第 18 行代碼使用 ReDim 語句為動態數組 arr 重新分配存儲空間。 第 19 行到第 24 行代碼循環取值，將“數據表”工作薄中指定工作表的數據賦給動態數組 arr。 第 25 行代碼將動態數組 arr 的值賦給工作表的單元格。 5、使用 SQL 連接使用 SQL 建立與工作簿的連接，查詢數據記錄后復制到當前工作表中，如下面的代碼所示。
Sub CopyData_5() Dim Sql As String
Dim j As Integer
Dim R As Integer
Dim Cnn As ADODB.Connection
Dim rs As ADODB.Recordset
With Sheet5
.Cells.Clear
Set Cnn = New ADODB.Connection
With Cnn
.Provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "Extended Properties=Excel 8.0;" _ & "Data Source=" & ThisWorkbook.Path & "￥數據表"
.Open
End With
Set rs = New ADODB.Recordset
Sql = "select * from [Sheet1$]"
rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic
For j = 0 To rs.Fields.Count - 1
.Cells(1, j + 1) = rs.Fields(j).Name
Next
R = .Range("A65536").End(xlUp).Row
.Range("A" & R + 1).CopyFromRecordset rs
End With
rs.Close
Cnn.Close
Set rs = Nothing
Set Cnn = Nothing
End Sub 代碼解析： CopyData_5 過程使建立與“數據表”工作簿的連接，查詢數據記錄后復制到當前工作表中。 第 8 行代碼刪除當前工作表的所有數據。 第 9 行到第 15 行代碼建立與“數據表”工作簿的連接。 第 16 行到第 24 行代碼查詢“數據表”工作簿的全部數據，并復制到工作表中。其中第 20 行代碼將字段名稱（標題行）復制到 工作表中，第 23 行代碼將查詢到的數據記錄復制到工作表。 其它收集的相關內容： 收集的相關內容 示例代碼 1： Sub testGetValuesFromClosedWorkbook() GetValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheet1", "A1:G20"
End Sub
Sub GetValuesFromAClosedWorkbook(fPath As String, fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange)
.FormulaArray = "='" & fPath & "\[" & fName & "]" & sName & "'!" & cellRange
.Value = .Value
End With
End Sub
本 示 例 包 含 一 個 子 過 程 GetValuesFromAClosedWorkbook ， 用 來 從 已 關 關 的 工 作 簿 中 獲 取 數 據 ， 主 過 程 testGetValuesFromClosedWorkbook 用來傳遞參數。本示例表示從 C 盤根目錄下的 Book1.xls 工作簿的工作表 Sheet1 中的 A1:G20 單元格區域內獲取數據，并將其復制到當前工作表相應單元格區域中。 示例代碼 2： 已前面的代碼相似，下面的 VBA 代碼從關關的工作簿中獲取值。 Sub ExtractDataFromClosedWorkBook() Application.ScreenUpdating = False '創建鏈接來從關閉的工作簿中獲取數據 '可以將相關代碼修改為相應的路徑和單元格
With [Sheet1!A1:B4]
.Value = "='" & ActiveWorkbook.Path & "\[testDataWorkbook.xls]Sheet1'!A1:B4"
'刪除鏈接
.Value = .Value
End With
Application.ScreenUpdating = True End Sub 其中，可以將代碼中的路徑修改為需要從中獲取值的工作簿的路徑，單元格也作相應的修改。 示例代碼 3： Sub GetDataFromClosedWorkbook() Dim wb As Workbook
Application.ScreenUpdating = False '以只讀方式打開工作簿
Set wb = Workbooks.Open("C:\文件夾名\文件.xls", True, True)
With ThisWorkbook.Worksheets("工作表名")
'從工作簿中讀取數據
.Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula
.Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula
.Range("A12").Formula = wb.Worksheets("源工作表名").Range("A30").Formula
.Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula
End With
wb.Close False
'關閉打開的源數據工作簿且不保存任何變化
Set wb = Nothing '釋放內存
Application.ScreenUpdating = True
End Sub
在運行程序時，打開所要獲取數據的工作簿，當取得數據后再關關該工作簿。將屏幕更新屬性值設置為 False，將看不出 源數據工作簿是否被打開過。本程序代碼中，“C:\文件夾名\文件.xls”、”源工作表名”代表工作簿所在的文件夾和工作簿 文件名。 示例代碼 4： 下面是 JOHN WALKENBACH 先生使用 VBA 編寫的一個實用函數，其作用是從關關的工作簿中取值。 VBA 沒有包含從關關的文件中獲取值的方法，但是利用 Excel 處理連接文件的功能，可以實現。該函數要調用 XLM 宏， 但不能在工作表公式中使用該函數。 GetValue 函數 具有四個參數，分別如下： path: 關 關 的文件的驅 動 器和路徑(例如”d:￥files”) file: 工作簿名稱(例如”99budget.xls”)
sheet: 工作表名稱(例如”Sheet1″)
ref: 單元格引用(例如”C4″)
Private Function GetValue(path, file, sheet, ref) ' 從一個關關的工作簿中獲取值
Dim arg As String ' 確保該文件存在
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' 創建參數
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
' 執行 XLM 宏
GetValue = ExecuteExcel4Macro(arg)
End Function
使用 GetValue 函數 要使用該函數，將其復制到 VBA 模塊中，然后使用合適的參數調用該函數。 子過程演示如下，簡單地顯示在名為 99Budget.xls 工作簿 Sheet1 的單元格 A1 中的值，該文件在驅動器 C:中的 XLFiles\Budget 目錄下。 Sub TestGetValue() p = "c:\XLFiles\Budget"
f = "99Budget.xls"
s = "Sheet1″"
a = "A1″"
MsgBox GetValue(p, f, s, a)
End Sub
另一個示例如下，該過程從一個有關 的文件中讀取 1,200 個值(100 行和 12 列)，并將這些值放置到活動工作表中。
Sub TestGetValue2() p = "c:\XLFiles\Budget"
f = "99Budget.xls"
s = "Sheet1″"
Application.ScreenUpdating = False
For r = 1 To 100
For c = 1 To 12
a = Cells(r, c).Address
Cells(r, c) = GetValue(p, f, s, a)
Next c
Next r
Application.ScreenUpdating = True
End Sub
注意： 為了使該函數正常運行，在 Excel 中必須有一個活動工作表。如果所有窗口都是隱藏的，或者活動工作表為圖表工作表， 那么將產生錯誤。 示例代碼 5：
Sub ReadDataFromAllWorkbooksInFolder() Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\文件夾名" '創建文件夾中工作簿列表
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
'從每個工作簿中獲取數據
r = 0
Workbooks.Add
For i = 1 To wbCount
r = r + 1 cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
Cells(r, 1).Formula = wbList(i)
Cells(r, 2).Formula = cValue
Next i
End Sub
Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function 本示例將讀取一個文件夾內所有工作簿中工作表 Sheet1 單元格 A1 的值到一個新工作簿中。代碼中，“C:\文件夾名”代 表工作簿所在的文件夾名。 |
|
|
