|
從有關的工作簿中取值有多種方法，現(xiàn)將網(wǎng)上收集的整理向大家共享。
方法 1、使用公式 方法 2、使用 GetObject 函數(shù) 、 方法 3、隱藏 Application 對象 方法 4、使用 ExecuteExcel4Macro 方法
方法 5、使用 SQL 連接 1、使用公式 、 如果需要引用的數(shù)據(jù)不是太多，可以使用公式取得引用工作簿中的工作表數(shù)據(jù)，如下面的代碼所示。
Sub CopyData_1() Dim Temp As String
Temp = "'" & ThisWorkbook.Path & "￥[數(shù)據(jù)表.xls]Sheet1'!"
With Sheet1.Range("A1:F22")
.FormulaR1C1 = "=" & Temp & "RC"
.Value = .Value
End With
End Sub 代碼解析： CopyData_1 過程在工作表中寫入公式引用“數(shù)據(jù)表”中同一位置單元格中的數(shù)據(jù)。 第 3 行代碼將引用工作簿的路徑賦給變量 Temp。 第 5 行代碼在作表中寫入公式引用數(shù)據(jù)。 第 6 行代碼將公式轉換為數(shù)值。 2、使用 GetObject 函數(shù) 、
使用 GetObject 函數(shù)來獲取對指定的 Excel 工作表的引用，如下面的代碼所示。 Sub CopyData_2() Dim Wb As Workbook
Dim Temp As String
Application.ScreenUpdating = False
Temp = ThisWorkbook.Path & "￥數(shù)據(jù)表.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 函數(shù)來獲取“數(shù)據(jù)表”工作簿中的數(shù)據(jù)。 第 4 行代碼關關屏幕更新加快運行速度。 第 5 行代碼將引用工作簿的路徑賦給變量 Temp。 第 6 行代碼使用 Set 語句將 GetObject 函數(shù)返回的對象賦給對象變量 Wb。 GetObject 函數(shù)返回文件中的 ActiveX 對象的引用，語法如下：
GetObject([pathname] [, class])
參數(shù) pathname 是可選的，包含待檢索對象的文件的全路徑和名稱。如果省略，則 class 參數(shù)是必需的。
參數(shù) class 是可選的，代表該對象的類的字符串。 Class 參數(shù)的格式為 appname.objecttype，語法的各個部分如表格 1 所示。
部分 描述
appname 必需的，提供該對象的應用程序名稱。 objecttype 必需的，待創(chuàng)建對象的類型或類。
表格 1 Class 參數(shù)語法的各個部分 第 7 行到第 10 行代碼，當 GetObject 函數(shù)指定的對象被激活之后，就可以在代碼中使用對象變量 Wb 來訪問這個對象的屬性 和方法。 其中第 7、8 行代碼將“數(shù)據(jù)表”工作簿中的第 1 張工作表已使用區(qū)域的數(shù)據(jù)賦給本工作表的單元格，第 9 行代碼關關“數(shù)據(jù)表”工 作簿，使用 GetObject 函數(shù)返回對象的引用時，雖然在窗口中看不到對象的實例，但實際上是打開的，所以需用 Close 語句將 其關關。 第 12 行代碼開啟屏幕更新。
3、隱藏 Application 對象 通過隱藏 Application 對象來模擬不打開工作簿取數(shù)，如下面的代碼所示。
Sub CopyData_3() Dim myApp As New Application
Dim Sh As Worksheet Dim Temp As String T
emp = ThisWorkbook.Path & "￥數(shù)據(jù)表.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 對象來模擬不打開工作簿取數(shù)。 第 2 行代碼使用 New 關鍵字隱式地創(chuàng)建一個 Application 對象。 第 6 行代碼將新創(chuàng)建的 Application 對象的 Visible 屬性設置為 False，使之隱藏。 第 7 行代碼使用 Open 方法打開“數(shù)據(jù)表”工作簿（關于 Open 方法請參閱技巧 42 ，因為工作簿是使用新創(chuàng)建的、隱藏的 Application 對象打開的，所以在窗口中是不可視的。 第 8 行到第 10 行代碼將“數(shù)據(jù)表”工作簿中的第 1 張工作表已使用區(qū)域的數(shù)據(jù)賦給本工作表的單元格。 第 11 行代碼使用 Quit 方法退出新打開的 Excel 程序。 4、使用 ExecuteExcel4Macro 方法 使用 ExecuteExcel4Macro 方法可以做到不打開工作簿的情況下獲取其他工作薄中指定工作表的數(shù)據(jù)，如下面的代碼所示。
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 & "￥[數(shù)據(jù)表.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 方法獲取“數(shù)據(jù)表”工作薄中指定工作表的數(shù)據(jù)。 第 14、16 行代碼使用 ExecuteExcel4Macro 方法執(zhí)行 Counta 函數(shù)取得“數(shù)據(jù)表”工作薄中指定工作表的行數(shù)和列數(shù)合計。 ExecuteExcel4Macro 方法執(zhí)行一個 Microsoft Excel 4.0 宏函數(shù)，然后返回此函數(shù)的結果，語法如下： expression.ExecuteExcel4Macro(String) 參數(shù) expression 是可選的，返回一個 Application 對象。 參數(shù) String 是必需的，一個不帶等號的 Microsoft Excel 4.0 宏語言函數(shù)，所有引用必須是像 R1C1 這樣的字符串。 因為 Microsoft Excel 4.0 宏不在當前工作簿或工作表的環(huán)境中求值，所有的引用都是外部引用，所以無需打開引用工作簿但是 需要明確指定工作簿名稱。 第 18 行代碼使用 ReDim 語句為動態(tài)數(shù)組 arr 重新分配存儲空間。 第 19 行到第 24 行代碼循環(huán)取值，將“數(shù)據(jù)表”工作薄中指定工作表的數(shù)據(jù)賦給動態(tài)數(shù)組 arr。 第 25 行代碼將動態(tài)數(shù)組 arr 的值賦給工作表的單元格。 5、使用 SQL 連接使用 SQL 建立與工作簿的連接，查詢數(shù)據(jù)記錄后復制到當前工作表中，如下面的代碼所示。
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 & "￥數(shù)據(jù)表"
.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 過程使建立與“數(shù)據(jù)表”工作簿的連接，查詢數(shù)據(jù)記錄后復制到當前工作表中。 第 8 行代碼刪除當前工作表的所有數(shù)據(jù)。 第 9 行到第 15 行代碼建立與“數(shù)據(jù)表”工作簿的連接。 第 16 行到第 24 行代碼查詢“數(shù)據(jù)表”工作簿的全部數(shù)據(jù)，并復制到工作表中。其中第 20 行代碼將字段名稱（標題行）復制到 工作表中，第 23 行代碼將查詢到的數(shù)據(jù)記錄復制到工作表。 其它收集的相關內容： 收集的相關內容 示例代碼 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 ， 用 來 從 已 關 關 的 工 作 簿 中 獲 取 數(shù) 據(jù) ， 主 過 程 testGetValuesFromClosedWorkbook 用來傳遞參數(shù)。本示例表示從 C 盤根目錄下的 Book1.xls 工作簿的工作表 Sheet1 中的 A1:G20 單元格區(qū)域內獲取數(shù)據(jù)，并將其復制到當前工作表相應單元格區(qū)域中。 示例代碼 2： 已前面的代碼相似，下面的 VBA 代碼從關關的工作簿中獲取值。 Sub ExtractDataFromClosedWorkBook() Application.ScreenUpdating = False '創(chuàng)建鏈接來從關閉的工作簿中獲取數(shù)據(jù) '可以將相關代碼修改為相應的路徑和單元格
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("工作表名")
'從工作簿中讀取數(shù)據(jù)
.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
'關閉打開的源數(shù)據(jù)工作簿且不保存任何變化
Set wb = Nothing '釋放內存
Application.ScreenUpdating = True
End Sub
在運行程序時，打開所要獲取數(shù)據(jù)的工作簿，當取得數(shù)據(jù)后再關關該工作簿。將屏幕更新屬性值設置為 False，將看不出 源數(shù)據(jù)工作簿是否被打開過。本程序代碼中，“C:\文件夾名\文件.xls”、”源工作表名”代表工作簿所在的文件夾和工作簿 文件名。 示例代碼 4： 下面是 JOHN WALKENBACH 先生使用 VBA 編寫的一個實用函數(shù)，其作用是從關關的工作簿中取值。 VBA 沒有包含從關關的文件中獲取值的方法，但是利用 Excel 處理連接文件的功能，可以實現(xiàn)。該函數(shù)要調用 XLM 宏， 但不能在工作表公式中使用該函數(shù)。 GetValue 函數(shù) 具有四個參數(shù)，分別如下： 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
' 創(chuàng)建參數(shù)
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
' 執(zhí)行 XLM 宏
GetValue = ExecuteExcel4Macro(arg)
End Function
使用 GetValue 函數(shù) 要使用該函數(shù)，將其復制到 VBA 模塊中，然后使用合適的參數(shù)調用該函數(shù)。 子過程演示如下，簡單地顯示在名為 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
注意： 為了使該函數(shù)正常運行，在 Excel 中必須有一個活動工作表。如果所有窗口都是隱藏的，或者活動工作表為圖表工作表， 那么將產(chǎn)生錯誤。 示例代碼 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:\文件夾名" '創(chuàng)建文件夾中工作簿列表
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
'從每個工作簿中獲取數(shù)據(jù)
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:\文件夾名”代 表工作簿所在的文件夾名。 |
|
|
