不打开工作簿取得其他工作簿数据

admin

51-1        使用公式

1. Sub CopyData_1()
   " l$ R9 P2 p* G" Y5 p; v* O( E2 U0 F
2.       Dim Temp As String
   ' Y7 Q: C. N& ]& ~& J% V! x  t
3.       Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"
   . A$ ^  k: y8 @- a! f" B
4.       With Sheet1.Range("A1:F22")
   2 l4 P  `( z0 t, L) b0 a# \9 z
5.           .FormulaR1C1 = "=" & Temp & "RC"
   , K& H- Y$ _! ?* A8 ]% k+ d
6.           .Value = .Value
   
7.       End With
   
8.   End Sub

复制代码

/ n( B  a' ?: ]& x0 x代码解析：
CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。
# ^3 t1 K& F8 z% i1 h/ W$ M第3行代码将引用工作簿的路径赋给变量Temp。
第5行代码在作表中写入公式引用数据。
第6行代码将公式转换为数值。

admin

51-2        使用GetObject函数

/ W* v( `8 h0 j

1. Sub CopyData_2()
     h8 ~- l  V1 X
2.       Dim Wb As Workbook
   . B: L4 k$ h5 s8 D# Y$ e. L
3.       Dim Temp As String
   5 O2 `- F9 Z# e0 l+ m" e1 l* |
4.       Application.ScreenUpdating = False
   ; e, h. a6 a! _. l8 l; O+ ]4 y' @
5.       Temp = ThisWorkbook.Path & "\数据表.xls"
   
6.       Set Wb = GetObject(Temp)
   
7.           With Wb.Sheets(1).Range("A1").CurrentRegion
   
8.               Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
   
9.               Wb.Close False
   
10.           End With
      j1 y8 N0 \  Z- m
11.       Set Wb = Nothing
    ( J( O9 I& Q  l
12.       Application.ScreenUpdating = True
    
13.   End Sub

复制代码

6 q% M6 Q" o4 M- d( _$ j代码解析：
8 m: C" Y- v7 m% ~CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。
! t. R" H. U; H+ [% g7 e- n* _第4行代码关闭屏幕更新加快运行速度。
第5行代码将引用工作簿的路径赋给变量Temp。
! u2 j6 M( Z6 M第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。
4 g# Z$ H* W3 C3 NGetObject函数返回文件中的ActiveX对象的引用
参数pathname是可选的，包含待检索对象的文件的全路径和名称。如果省略，则class参数是必需的。
5 l0 R4 X8 Q' y; T5 ~$ @" P参数class是可选的，代表该对象的类的字符串。
第7行到第10行代码，当GetObject函数指定的对象被激活之后，就可以在代码中使用对象变量Wb来访问这个对象的属性和方法。
% B* @0 I! X' i+ c$ v其中第7、8行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格，第9行代码关闭“数据表”工作簿，使用GetObject函数返回对象的引用时，虽然在窗口中看不到对象的实例，但实际上是打开的，所以需用Close语句将其关闭。
7 i5 h" `$ k! C. m( d+ v# u) p: _第12行代码开启屏幕更新。
& Q5 U* P) E% t/ H

admin

51-3        隐藏Application对象
通过隐藏Application对象来模拟不打开工作簿取数，如下面的代码所示。

1. Sub CopyData_3()
   
2.       Dim myApp As New Application
   4 n6 u( k$ }: F, e$ X* r
3.       Dim Sh As Worksheet
   $ O2 y% ?; ?: s
4.       Dim Temp As String
   1 l' R/ B1 N: J* t- k8 e! b5 H/ U$ V
5.       Temp = ThisWorkbook.Path & "\数据表.xls"
   
6.       myApp.Visible = False
   
7.       Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)
   4 B( @* u% }5 |, u* Z% Q1 T3 F
8.       With Sh.Range("A1").CurrentRegion
   
9.           Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
   , I0 x/ ?$ j5 e7 S. ?9 ~2 _* Y
10.       End With
    
11.       myApp.Quit
    
12.       Set Sh = Nothing
    + R7 ^" k4 ]5 }
13.       Set myApp = Nothing
    
14. End Sub

复制代码

代码解析：
( f! f: O+ U. f9 ]; [. a" v( XCopyData_3过程隐藏Application对象来模拟不打开工作簿取数。
第2行代码使用New关键字隐式地创建一个Application对象。
第6行代码将新创建的Application对象的Visible属性设置为False，使之隐藏。
3 k% @1 F2 s" {第7行代码使用Open方法打开“数据表”工作簿（关于Open方法请参阅技巧42 ，因为工作簿是使用新创建的、隐藏的Application对象打开的，所以在窗口中是不可视的。
' a. @" b- h0 o1 X! T第8行到第10行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格。
- H; F  I2 z1 \2 D第11行代码使用Quit方法退出新打开的Excel程序。

admin

51-4  使用ExecuteExcel4Macro方法

//  使用ExecuteExcel4Macro方法可以做到不打开工作簿的情况下获取其他工作薄中指定工作表的数据，如下面的代码所示。

1. Sub CopyData_4()
   * t* |& a' v7 y  s: f! B
2.       Dim RCount As Long
   ! _8 l5 o. t3 x! c- d
3.       Dim CCount As Long
   
4.       Dim Temp As String
   
5.       Dim Temp1 As String
   5 k* ?* s- p) \7 j* v
6.       Dim Temp2 As String
   / T) ]+ M  _8 z( ~7 V4 K( _
7.       Dim Temp3 As String
   
8.       Dim R As Long
   
9.       Dim C As Long
   - s% i9 N7 G: c9 ^+ c& P
10.       Dim arr() As Variant
    
11.       Temp = "'" &ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"
    
12.       Temp1 = Temp & Rows(1).Address(, ,xlR1C1)
    
13.       Temp1 = "Counta(" & Temp1& ")"
      }0 q  M5 q  R$ x* [
14.       CCount =Application.ExecuteExcel4Macro(Temp1)
    % c: O8 ~% ^; q3 D
15.       Temp2 = Temp &Columns("A").Address(, , xlR1C1)
    
16.       Temp2 = "Counta(" & Temp2& ")"
    
17.       RCount = Application.ExecuteExcel4Macro(Temp2)
    
18.       ReDim arr(1 To RCount, 1 To CCount)
    
19.       For R = 1 To RCount
    
20.           For C = 1 To CCount
    
21.               Temp3 = Temp & Cells(R,C).Address(, , xlR1C1)
    + U; u  H( {! g4 Z4 G
22.               arr(R, C) = Application.ExecuteExcel4Macro(Temp3)
    * u0 A3 U# h: a, m0 \
23.           Next
    
24.       Next
    # G$ ~3 V& A( J0 b
25.       Range("A1").Resize(RCount,CCount).Value = arr
      }: R# \, U! |7 F2 Y) c9 o
26. 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 Excel4.0 宏不在当前工作簿或工作表的环境中求值，所有的引用都是外部引用，所以无需打开引用工作簿但是需要明确指定工作簿名称。

第18行代码使用ReDim语句为动态数组arr重新分配存储空间。

第19行到第24行代码循环取值，将“数据表”工作薄中指定工作表的数据赋给动态数组arr。

第25行代码将动态数组arr的值赋给工作表的单元格。

4 O8 p$ Y: ?& x, S' _
; n" ~2 B' k: c
7 ~/ m0 q! [+ _4 U

admin

51-5        使用SQL连接
/ R1 Z, ]  o) B' m; o+ R

//  使用SQL建立与工作簿的连接，查询数据记录后复制到当前工作表中，如下面的代码所示。

1. Sub CopyData_5()
   4 c4 o' m* p' |% x7 a3 V/ R2 c
2.       Dim Sql As String
   ' V4 D- q) x% v+ E7 }% O# z
3.       Dim j As Integer
   6 T9 K& X% W$ G8 A$ a5 Y/ e# r6 d
4.       Dim R As Integer
   
5.       Dim Cnn As ADODB.Connection
   ! W% G$ A5 Q- T4 Y) z2 D
6.       Dim rs As ADODB.Recordset
   
7.       With Sheet5
   4 ^( n( K. i3 n7 l1 f' r
8.           .Cells.Clear
   
9.           Set Cnn = New ADODB.Connection
   
10.           With Cnn
    
11.               .Provider = "microsoft.jet.oledb.4.0"
    ! y1 I* m5 A: {3 L8 `7 R" D
12.               .ConnectionString = "Extended Properties=Excel 8.0;" _
    % M6 Q* Z# G. [% ]
13.                   & "Data Source=" & ThisWorkbook.Path & "\数据表"
    
14.               .Open
    
15.           End With
    
16.           Set rs = New ADODB.Recordset
    
17.           Sql = "select * from [Sheet1$]"
    % Z+ \" M0 t- T, k
18.           rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic
    
19.               For j = 0 To rs.Fields.Count - 1
    % h- v' R  A- t  c& ], e/ p
20.                   .Cells(1, j + 1) = rs.Fields(j).Name
    * u! J6 {& ?& ~4 Z% f+ I
21.               Next
    # V6 q( _8 U# H% b
22.           R = .Range("A65536").End(xlUp).Row
    4 A' |5 A1 d; f; l7 A  T) I
23.           .Range("A" & R + 1).CopyFromRecordset rs
    % B" \/ \: S1 g1 O. y6 r0 t
24.       End With
    
25.       rs.Close
    
26.       Cnn.Close
    % J  b( o4 ]& v# f
27.       Set rs = Nothing
    8 Q+ _6 b9 J: h. Z+ a, M, |
28.       Set Cnn = Nothing
    
29. End Sub

复制代码

% X$ S$ M. K6 L  e+ m代码解析：
CopyData_5过程使建立与“数据表”工作簿的连接，查询数据记录后复制到当前工作表中。
第8行代码删除当前工作表的所有数据。
0 D" J: Q" K& y* x) ^/ }" E第9行到第15行代码建立与“数据表”工作簿的连接。
8 o2 s8 M0 |3 l; b6 s9 _2 G2 v第16行到第24行代码查询“数据表”工作簿的全部数据，并复制到工作表中。
" W+ P* y( `. o% n6 v& I第20行代码将字段名称（标题行）复制到工作表中，
: G5 v! `, d0 ]$ C/ R1 o( i第23行代码将查询到的数据记录复制到工作表。
/ E/ B! I! o& V! w6 ?) d* ]




& {+ F) H. ^( V. D, J0 b# L; l