VBA常用技巧代码解析

itxianfeng

下载的手都酸了，也同时被版主的执着精神所感动，在此谢谢版主。
我是将内容一一复制粘贴到WORD文档里面，请问有没有更快速下载的方法，

poor.456

lkzks333

正在学习中，缺乏实战，总觉得有点高深，这下好了，谢谢版主！

mao11wei

楼主辛苦，很实用的东西，谢谢了

yuanzhuping

原帖由 yumoym 于 2009-2-26 11:37 发表
给我最尊重的版主挑个小瑕疵
版主说：“此方法（Address引用法）只适用于单个单元格或者加上OR运算符可以适用于几个单元格，多则不方便。”，可我发现address属性也可以返回区域名，如A1:B2之类的呀！

不错，address属性可以返回区域，但是如果事件中代码改成这样的：
If Target.Address(0, 0) = "A1:B1" Then
那就只有在选择A1和B1两个单元格的情况下才触发事件，选中其中一个是不会触发的。如果希望选中A1或B1的情况下触发事件，代码只有这样：
If Target.Address(0, 0) = "A1" Or Target.Address(0, 0) = "B1" Then
所以说多则不方便。

yuanzhuping

原帖由 itxianfeng 于 2009-2-26 12:02 发表
下载的手都酸了，也同时被版主的执着精神所感动，在此谢谢版主。
我是将内容一一复制粘贴到WORD文档里面，请问有没有更快速下载的方法，

这个不需要复制粘贴到WORD文档里面，第一部分都有WORD文档供下载的，待完成后也会有完整的WORD文档供大家下载，如果有哪位朋友能制成电子书就更好了。

yuanzhuping

技巧51         不打开工作簿取得其他工作簿数据
       在Excel的使用过程中，经常需要引用其他工作簿的数据，而用户往往希望能在不打开工作簿或看似不打开工作簿的情况下取得其他工作簿中的数据，有以下几种方法可以实现。
51-1        使用公式
       如果需要引用的数据不是太多，可以使用公式取得引用工作簿中的工作表数据，如下面的代码所示。

1. #001  Sub CopyData_1()
   
2. #002      Dim Temp As String
   
3. #003      Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"
   
4. #004      With Sheet1.Range("A1:F22")
   
5. #005          .FormulaR1C1 = "=" & Temp & "RC"
   
6. #006          .Value = .Value
   
7. #007      End With
   
8. #008  End Sub

复制代码

代码解析：
       CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。
       第3行代码将引用工作簿的路径赋给变量Temp。
       第5行代码在作表中写入公式引用数据。
       第6行代码将公式转换为数值。
51-2        使用GetObject函数
       使用GetObject函数来获取对指定的Excel工作表的引用，如下面的代码所示。

1. #001  Sub CopyData_2()
   
2. #002      Dim Wb As Workbook
   
3. #003      Dim Temp As String
   
4. #004      Application.ScreenUpdating = False
   
5. #005      Temp = ThisWorkbook.Path & "\数据表.xls"
   
6. #006      Set Wb = GetObject(Temp)
   
7. #007          With Wb.Sheets(1).Range("A1").CurrentRegion
   
8. #008              Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
   
9. #009              Wb.Close False
   
10. #010          End With
    
11. #011      Set Wb = Nothing
    
12. #012      Application.ScreenUpdating = True
    
13. #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对象来模拟不打开工作簿取数，如下面的代码所示。

1. #001  Sub CopyData_3()
   
2. #002      Dim myApp As New Application
   
3. #003      Dim Sh As Worksheet
   
4. #004      Dim Temp As String
   
5. #005      Temp = ThisWorkbook.Path & "\数据表.xls"
   
6. #006      myApp.Visible = False
   
7. #007      Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)
   
8. #008      With Sh.Range("A1").CurrentRegion
   
9. #009          Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
   
10. #010      End With
    
11. #011      myApp.Quit
    
12. #012      Set Sh = Nothing
    
13. #013      Set myApp = Nothing
    
14. #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方法可以做到不打开工作表的情况下获取其他工作薄中指定工作表的数据，如下面的代码所示。

1. #001  Sub CopyData_4()
   
2. #002      Dim RCount As Long
   
3. #003      Dim CCount As Long
   
4. #004      Dim Temp As String
   
5. #005      Dim Temp1 As String
   
6. #006      Dim Temp2 As String
   
7. #007      Dim Temp3 As String
   
8. #008      Dim R As Long
   
9. #009      Dim C As Long
   
10. #010      Dim arr() As Variant
    
11. #011      Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"
    
12. #012      Temp1 = Temp & Rows(1).Address(, , xlR1C1)
    
13. #013      Temp1 = "Counta(" & Temp1 & ")"
    
14. #014      CCount = Application.ExecuteExcel4Macro(Temp1)
    
15. #015      Temp2 = Temp & Columns("A").Address(, , xlR1C1)
    
16. #016      Temp2 = "Counta(" & Temp2 & ")"
    
17. #017      RCount = Application.ExecuteExcel4Macro(Temp2)
    
18. #018      ReDim arr(1 To RCount, 1 To CCount)
    
19. #019      For R = 1 To RCount
    
20. #020          For C = 1 To CCount
    
21. #021              Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)
    
22. #022              arr(R, C) = Application.ExecuteExcel4Macro(Temp3)
    
23. #023          Next
    
24. #024      Next
    
25. #025      Range("A1").Resize(RCount, CCount).Value = arr
    
26. #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建立与工作簿的连接，查询数据记录后复制到当前工作表中，如下面的代码所示。

1. #001  Sub CopyData_5()
   
2. #002      Dim Sql As String
   
3. #003      Dim j As Integer
   
4. #004      Dim R As Integer
   
5. #005      Dim Cnn As ADODB.Connection
   
6. #006      Dim rs As ADODB.Recordset
   
7. #007      With Sheet5
   
8. #008          .Cells.Clear
   
9. #009          Set Cnn = New ADODB.Connection
   
10. #010          With Cnn
    
11. #011              .Provider = "microsoft.jet.oledb.4.0"
    
12. #012              .ConnectionString = "Extended Properties=Excel 8.0;" _
    
13. #013                  & "Data Source=" & ThisWorkbook.Path & "\数据表"
    
14. #014              .Open
    
15. #015          End With
    
16. #016          Set rs = New ADODB.Recordset
    
17. #017          Sql = "select * from [Sheet1$]"
    
18. #018          rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic
    
19. #019              For j = 0 To rs.Fields.Count - 1
    
20. #020                  .Cells(1, j + 1) = rs.Fields(j).Name
    
21. #021              Next
    
22. #022          R = .Range("A65536").End(xlUp).Row
    
23. #023          .Range("A" & R + 1).CopyFromRecordset rs
    
24. #024      End With
    
25. #025      rs.Close
    
26. #026      Cnn.Close
    
27. #027      Set rs = Nothing
    
28. #028      Set Cnn = Nothing
    
29. #029  End Sub

复制代码

代码解析：
       CopyData_5过程使建立与“数据表”工作簿的连接，查询数据记录后复制到当前工作表中。
       第8行代码删除当前工作表的所有数据。
       第9行到第15行代码建立与“数据表”工作簿的连接。
       第16行到第24行代码查询“数据表”工作簿的全部数据，并复制到工作表中。其中第20行代码将字段名称（标题行）复制到工作表中，第23行代码将查询到的数据记录复制到工作表。

ynlyjl123

感谢版主的分享,谢谢

一_一

原帖由 menghuazhang 于 2009-2-25 21:21 发表
谢谢236楼的一_一，非常感谢你的分享，能否将代码或是附件传上，以便我这个菜鸟拿回研习？

期待你的恢复-------关于删除所有Sheet1 中的空行。还有，如果我要是再增加一条需求：除了删除整个空行，如果在某一行中 ...

关于删除所有Sheet1 中的空行。还有，如果我要是再增加一条需求：除了删除整个空行，如果在某一行中在规定列（B列单元格不为空，但该行的其他单元格为空则删除该行）
这是我在yuan版主的技巧31基础上根据实际情况修改而成的,仅供menghuazhang朋友参考,不知是否符合要求.
其实我说的删除所有空行是指已使用区域首行前的空行,因为已使用区域后面肯定都是空行,删了之后又会生成空行.

zhangyh6955

谢谢楼主，很实用的内容