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