|
楼主 |
发表于 2009-2-26 16:06
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
第3部分 Wordbook(工作簿)对象
技巧51 不打开工作簿取得其他工作簿数据
在Excel的使用过程中,经常需要引用其他工作簿的数据,而用户往往希望能在不打开工作簿或看似不打开工作簿的情况下取得其他工作簿中的数据,有以下几种方法可以实现。
51-1 使用公式
如果需要引用的数据不是太多,可以使用公式取得引用工作簿中的工作表数据,如下面的代码所示。- #001 Sub CopyData_1()
- #002 Dim Temp As String
- #003 Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"
- #004 With Sheet1.Range("A1:F22")
- #005 .FormulaR1C1 = "=" & Temp & "RC"
- #006 .Value = .Value
- #007 End With
- #008 End Sub
复制代码 代码解析:
CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。
第3行代码将引用工作簿的路径赋给变量Temp。
第5行代码在作表中写入公式引用数据。
第6行代码将公式转换为数值。
51-2 使用GetObject函数
使用GetObject函数来获取对指定的Excel工作表的引用,如下面的代码所示。- #001 Sub CopyData_2()
- #002 Dim Wb As Workbook
- #003 Dim Temp As String
- #004 Application.ScreenUpdating = False
- #005 Temp = ThisWorkbook.Path & "\数据表.xls"
- #006 Set Wb = GetObject(Temp)
- #007 With Wb.Sheets(1).Range("A1").CurrentRegion
- #008 Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
- #009 Wb.Close False
- #010 End With
- #011 Set Wb = Nothing
- #012 Application.ScreenUpdating = True
- #013 End Sub
复制代码 代码解析:
CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。
第4行代码关闭屏幕更新加快运行速度。
第5行代码将引用工作簿的路径赋给变量Temp。
第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。
GetObject函数返回文件中的ActiveX对象的引用,语法如下:
GetObject([pathname] [, class])
参数pathname是可选的,包含待检索对象的文件的全路径和名称。如果省略,则class参数是必需的。
参数class是可选的,代表该对象的类的字符串。
Class参数的格式为appname.objecttype,语法的各个部分如表格所示。
第7行到第10行代码,当GetObject函数指定的对象被激活之后,就可以在代码中使用对象变量Wb来访问这个对象的属性和方法。
其中第7、8行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格,第9行代码关闭“数据表”工作簿,使用GetObject函数返回对象的引用时,虽然在窗口中看不到对象的实例,但实际上是打开的,所以需用Close语句将其关闭。
第12行代码开启屏幕更新。
51-3 隐藏Application对象
通过隐藏Application对象来模拟不打开工作簿取数,如下面的代码所示。- #001 Sub CopyData_3()
- #002 Dim myApp As New Application
- #003 Dim Sh As Worksheet
- #004 Dim Temp As String
- #005 Temp = ThisWorkbook.Path & "\数据表.xls"
- #006 myApp.Visible = False
- #007 Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)
- #008 With Sh.Range("A1").CurrentRegion
- #009 Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
- #010 End With
- #011 myApp.Quit
- #012 Set Sh = Nothing
- #013 Set myApp = Nothing
- #014 End Sub
复制代码 代码解析:
CopyData_3过程隐藏Application对象来模拟不打开工作簿取数。
第2行代码使用New关键字隐式地创建一个Application对象。
第6行代码将新创建的Application对象的Visible属性设置为False,使之隐藏。
第7行代码使用Open方法打开“数据表”工作簿(关于Open方法请参阅技巧42) ,因为工作簿是使用新创建的、隐藏的Application对象打开的,所以在窗口中是不可视的。
第8行到第10行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格。
第11行代码使用Quit方法退出新打开的Excel程序。
51-4 使用ExecuteExcel4Macro方法
使用ExecuteExcel4Macro方法可以做到不打开工作表的情况下获取其他工作薄中指定工作表的数据,如下面的代码所示。- #001 Sub CopyData_4()
- #002 Dim RCount As Long
- #003 Dim CCount As Long
- #004 Dim Temp As String
- #005 Dim Temp1 As String
- #006 Dim Temp2 As String
- #007 Dim Temp3 As String
- #008 Dim R As Long
- #009 Dim C As Long
- #010 Dim arr() As Variant
- #011 Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"
- #012 Temp1 = Temp & Rows(1).Address(, , xlR1C1)
- #013 Temp1 = "Counta(" & Temp1 & ")"
- #014 CCount = Application.ExecuteExcel4Macro(Temp1)
- #015 Temp2 = Temp & Columns("A").Address(, , xlR1C1)
- #016 Temp2 = "Counta(" & Temp2 & ")"
- #017 RCount = Application.ExecuteExcel4Macro(Temp2)
- #018 ReDim arr(1 To RCount, 1 To CCount)
- #019 For R = 1 To RCount
- #020 For C = 1 To CCount
- #021 Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)
- #022 arr(R, C) = Application.ExecuteExcel4Macro(Temp3)
- #023 Next
- #024 Next
- #025 Range("A1").Resize(RCount, CCount).Value = arr
- #026 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的值赋给工作表的单元格。
51-5 使用SQL连接
使用SQL建立与工作簿的连接,查询数据记录后复制到当前工作表中,如下面的代码所示。- #001 Sub CopyData_5()
- #002 Dim Sql As String
- #003 Dim j As Integer
- #004 Dim R As Integer
- #005 Dim Cnn As ADODB.Connection
- #006 Dim rs As ADODB.Recordset
- #007 With Sheet5
- #008 .Cells.Clear
- #009 Set Cnn = New ADODB.Connection
- #010 With Cnn
- #011 .Provider = "microsoft.jet.oledb.4.0"
- #012 .ConnectionString = "Extended Properties=Excel 8.0;" _
- #013 & "Data Source=" & ThisWorkbook.Path & "\数据表"
- #014 .Open
- #015 End With
- #016 Set rs = New ADODB.Recordset
- #017 Sql = "select * from [Sheet1$]"
- #018 rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic
- #019 For j = 0 To rs.Fields.Count - 1
- #020 .Cells(1, j + 1) = rs.Fields(j).Name
- #021 Next
- #022 R = .Range("A65536").End(xlUp).Row
- #023 .Range("A" & R + 1).CopyFromRecordset rs
- #024 End With
- #025 rs.Close
- #026 Cnn.Close
- #027 Set rs = Nothing
- #028 Set Cnn = Nothing
- #029 End Sub
复制代码 代码解析:
CopyData_5过程使建立与“数据表”工作簿的连接,查询数据记录后复制到当前工作表中。
第8行代码删除当前工作表的所有数据。
第9行到第15行代码建立与“数据表”工作簿的连接。
第16行到第24行代码查询“数据表”工作簿的全部数据,并复制到工作表中。其中第20行代码将字段名称(标题行)复制到工作表中,第23行代码将查询到的数据记录复制到工作表。 |
评分
-
2
查看全部评分
-
|