VBA常用技巧代码解析

yuanzhuping

技巧5         查找单元格
5-1        使用Find方法
       在Excel中使用查找对话框可以查找工作表中特定内容的单元格，而在VBA中则使用Find方法，如下面的代码所示。

2. #001  Sub RngFind()
   
3. #002      Dim StrFind As String
   
4. #003      Dim Rng As Range
   
5. #004      StrFind = InputBox("请输入要查找的值:")
   
6. #005      If Trim(StrFind) <> "" Then
   
7. #006          With Sheet1.Range("A:A")
   
8. #007              Set Rng = .Find(What:=StrFind, _
   
9. #008                              After:=.Cells(.Cells.Count), _
   
10. #009                              LookIn:=xlValues, _
    
11. #010                              LookAt:=xlWhole, _
    
12. #011                              SearchOrder:=xlByRows, _
    
13. #012                              SearchDirection:=xlNext, _
    
14. #013                              MatchCase:=False)
    
15. #014              If Not Rng Is Nothing Then
    
16. #015                  Application.Goto Rng, True
    
17. #016              Else
    
18. #017                  MsgBox "没有找到该单元格!"
    
19. #018              End If
    
20. #019          End With
    
21. #020      End If
    
22. #021  End Sub

#001  Sub RngFind()<br /> #002      Dim StrFind As String<br /> #003      Dim Rng As Range<br /> #004      StrFind = InputBox("请输入要查找的值:")<br /> #005      If Trim(StrFind) <> "" Then<br /> #006          With Sheet1.Range("A:A")<br /> #007              Set Rng = .Find(What:=StrFind, _<br /> #008                              After:=.Cells(.Cells.Count), _<br /> #009                              LookIn:=xlValues, _<br /> #010                              LookAt:=xlWhole, _<br /> #011                              SearchOrder:=xlByRows, _<br /> #012                              SearchDirection:=xlNext, _<br /> #013                              MatchCase:=False)<br /> #014              If Not Rng Is Nothing Then<br /> #015                  Application.Goto Rng, True<br /> #016              Else<br /> #017                  MsgBox "没有找到该单元格!"<br /> #018              End If<br /> #019          End With<br /> #020      End If<br /> #021  End Sub

代码解析：
       RngFind过程使用Find方法在工作表Sheet1的A列中查找InputBox函数对话框中所输入的值，并查找该值所在的第一个单元格。
       第6到第13行代码在工作表Sheet1的A列中查找InputBox函数对话框中所输入的值。应用于Range对象的Find方法在区域中查找特定信息，并返回Range对象，该对象代表用于查找信息的第一个单元格。如果未发现匹配单元格，就返回Nothing，语法如下：
expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SerchFormat)
       参数expression是必需的，该表达式返回一个Range对象。
       参数What是必需的，要搜索的数据，可为字符串或任意数据类型。
       参数After是可选的，表示搜索过程将从其之后开始进行的单元格，必须是区域中的单个单元格。查找时是从该单元格之后开始的，直到本方法绕回到指定的单元格时，才对其进行搜索。如果未指定本参数，搜索将从区域的左上角单元格之后开始。
       在本例中将After参数设置为A列的最后一个单元格，所以查找时从A1单元格开始搜索。
       参数LookIn是可选的，信息类型。
       参数LookAt是可选的，可为XlLookAt常量的xlWhole 或xlPart之一。
       参数SearchOrder是可选的，可为XlSearchOrder常量的xlByRows或xlByColumns之一。
       参数SearchDirection是可选的，搜索的方向，可为XlSearchDirection常量的xlNext或xlPrevious之一。
       参数MatchCase是可选的，若为True，则进行区分大小写的查找。默认值为False。
       参数MatchByte是可选的，仅在选择或安装了双字节语言支持时使用。若为True，则双字节字符仅匹配双字节字符。若为False，则双字节字符可匹配其等价的单字节字符。
       参数SerchFormat是可选的，搜索的格式。
       每次使用Find方法后，参数LookIn、LookAt、SearchOrder 和MatchByte的设置将保存。如果下次调用Find方法时不指定这些参数的值，就使用保存的值。因此每次使用该方法时请明确设置这些参数。
       如果工作表的A列中存在重复的数值，那么需要使用FindNext方法或FindPrevious方法进行重复搜索，如下面的代码所示。

2. #001  Sub RngFindNext()
   
3. #002      Dim StrFind As String
   
4. #003      Dim Rng As Range
   
5. #004      Dim FindAddress As String
   
6. #005      StrFind = InputBox("请输入要查找的值:")
   
7. #006      If Trim(StrFind) <> "" Then
   
8. #007          With Sheet1.Range("A:A")
   
9. #008              Set Rng = .Find(What:=StrFind, _
   
10. #009                              After:=.Cells(.Cells.Count), _
    
11. #010                              LookIn:=xlValues, _
    
12. #011                              LookAt:=xlWhole, _
    
13. #012                              SearchOrder:=xlByRows, _
    
14. #013                              SearchDirection:=xlNext, _
    
15. #014                              MatchCase:=False)
    
16. #015              If Not Rng Is Nothing Then
    
17. #016                  FindAddress = Rng.Address
    
18. #017                  Do
    
19. #018                      Rng.Interior.ColorIndex = 6
    
20. #019                      Set Rng = .FindNext(Rng)
    
21. #020                  Loop While Not Rng Is Nothing And Rng.Address <> FindAddress
    
22. #021              End If
    
23. #022          End With
    
24. #023      End If
    
25. #024  End Sub

#001  Sub RngFindNext()<br /> #002      Dim StrFind As String<br /> #003      Dim Rng As Range<br /> #004      Dim FindAddress As String<br /> #005      StrFind = InputBox("请输入要查找的值:")<br /> #006      If Trim(StrFind) <> "" Then<br /> #007          With Sheet1.Range("A:A")<br /> #008              Set Rng = .Find(What:=StrFind, _<br /> #009                              After:=.Cells(.Cells.Count), _<br /> #010                              LookIn:=xlValues, _<br /> #011                              LookAt:=xlWhole, _<br /> #012                              SearchOrder:=xlByRows, _<br /> #013                              SearchDirection:=xlNext, _<br /> #014                              MatchCase:=False)<br /> #015              If Not Rng Is Nothing Then<br /> #016                  FindAddress = Rng.Address<br /> #017                  Do<br /> #018                      Rng.Interior.ColorIndex = 6<br /> #019                      Set Rng = .FindNext(Rng)<br /> #020                  Loop While Not Rng Is Nothing And Rng.Address <> FindAddress<br /> #021              End If<br /> #022          End With<br /> #023      End If<br /> #024  End Sub

代码解析：
       RngFindNext过程在工作表Sheet1的A列中查找InputBox函数对话框中所输入的值，并将查到单元格底色设置成黄色。
       第8行到第17行代码使用Find方法在工作表Sheet1的A列中查找。
       第16行代码将查找到的第一个单元格地址赋给字符串变量FindAddress。
       第18行代码将查找到的单元格底色设置成黄色。
       第19行代码使用FindNext方法进行重复搜索。FindNext方法继续执行用Find方法启动的搜索。查找下一个匹配相同条件的单元格并返回代表单元格的Range对象，语法如下：
expression.FindNext(After)
       参数expression是必需的，返回一个Range对象。
       参数After是可选的，指定一个单元格，查找将从该单元格之后开始。
       第20行代码如果查找到的单元格地址等于字符串变量FindAddress所记录的地址，说明A列已搜索完毕，结束查找过程。
       运行RngFindNext过程，在InputBox函数输入框中输入“196.01”后结果如所示。

       还可以使用FindPrevious方法进行重复搜索，FindPrevious方法的语法如下：
expression.FindPrevious(After)
       FindPrevious方法和FindNext方法唯一的区别是FindPrevious方法查找匹配相同条件的前一个单元格而FindNext方法是查找匹配相同条件的下一个单元格。

[ 本帖最后由 yuanzhuping 于 2009-2-16 22:06 编辑 ]

yuanzhuping

技巧5         查找单元格
5-2        使用Like运算符
       使用Like运算符可以进行更为复杂的模式匹配查找，如下面的代码所示。

2. #001  Sub RngLike()
   
3. #002      Dim rng As Range
   
4. #003      Dim a As Integer
   
5. #004      a = 1
   
6. #005      With Sheet2
   
7. #006          .Range("A:A").ClearContents
   
8. #007          For Each rng In .Range("B1:E1000")
   
9. #008              If rng.Text Like "*a*" Then
   
10. #009                  .Range("A" & a) = rng.Text
    
11. #010                  a = a + 1
    
12. #011              End If
    
13. #012          Next
    
14. #013      End With
    
15. #014  End Sub

#001  Sub RngLike()<br /> #002      Dim rng As Range<br /> #003      Dim a As Integer<br /> #004      a = 1<br /> #005      With Sheet2<br /> #006          .Range("A:A").ClearContents<br /> #007          For Each rng In .Range("B1:E1000")<br /> #008              If rng.Text Like "*a*" Then<br /> #009                  .Range("A" & a) = rng.Text<br /> #010                  a = a + 1<br /> #011              End If<br /> #012          Next<br /> #013      End With<br /> #014  End Sub

代码解析：
       RngLike过程使用For Each...Next语句和Like运算符在单元格区域B1:E10000中搜索含有“a”字符的单元格，找到匹配单元格以后将单元格的值写入到A列中。
       第6行代码使用ClearContents方法清除A列区域的数据。
       第7行代码使用For Each...Next语句在单元格区域B1:E10000中循环。
       第8行代码使用Like运算符在单元格区域B1:E10000中搜索含有“a”字符的单元格。
       Like运算符用来比较两个字符串，语法如下：
result = string Like pattern
       参数string是必需的，字符串表达式。
       参数pattern是必需的，字符串表达式。
       如果string与pattern匹配，则result为True；如果不匹配，则result为False。但是如果string或pattern 中有一个为Null，则result 为 Null。
       参数pattern可以使用通配符、字符串列表或字符区间的任何组合来匹配字符串。表格中列出pattern中允许的字符以及它们与什么进行匹配。

       第9行代码将找到的匹配单元格的值写入到A列中。
       运行RngLike过程结果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 22:08 编辑 ]

gwfzh

谢谢分享！一定要努力学习

yuanzhuping

技巧6         替换单元格内字符串
       如果需要替换单元格内指定的字符串，那么使用Range对象的Replace方法，如下面的代码所示。

2. #001  Sub RngReplace()
   
3. #002      Range("A1:A5").Replace "通州", "南通"
   
4. #003  End Sub

#001  Sub RngReplace()<br /> #002      Range("A1:A5").Replace "通州", "南通"<br /> #003  End Sub

代码解析：
       RngReplace过程将工作表A1:A5单元格中的“通州”字符串替换成“南通”字符串。
       应用于Range对象的Replace方法替换指定区域内单元格中的字符，语法如下：
expression.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte, SearchFormat, ReplaceFormat)
       其中参数expression是必需的，返回一个Range对象。
       参数What是必需的，要搜索的字符串。
       参数Replacement是必需的，替换的字符串。
       运行RngReplace过程前工作表如图所示。

       运行RngReplace过程后结果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 22:59 编辑 ]

yuanzhuping

技巧7         复制单元格区域
       在实际操作中，经常需要复制指定的单元格区域到另外一个单元格区域。要复制指定单元格区域到其他位置，使用Range对象的Copy方法，如下面的代码所示。

2. #001  Sub RangeCopy()
   
3. #002      Application.DisplayAlerts = False
   
4. #003      Sheet1.Range("A1").CurrentRegion.Copy Sheet2.Range("A1")
   
5. #004      Application.DisplayAlerts = True
   
6. #005  End Sub

#001  Sub RangeCopy()<br /> #002      Application.DisplayAlerts = False<br /> #003      Sheet1.Range("A1").CurrentRegion.Copy Sheet2.Range("A1")<br /> #004      Application.DisplayAlerts = True<br /> #005  End Sub

代码解析：
       RangeCopy过程将如图所示的Sheet1工作表中A1单元格的当前区域复制到Sheet2工作表中以A1单元格为左上角单元格的区域。

       Sheet2工作表复制后如图所示。

       Range对象的Copy方法的语法如下：
Copy(Destination)
       参数Destination表示复制单元格区域的目标区域，如果省略该参数，Excel将把该区域复制到剪贴板中。使用Copy方法复制单元格区域时，也复制了该单元格区域的格式。
       复制单元格区域时，如果目标区域为非空单元格区域，Excel将显示如图所示的消息框提示是否替换单元格内容，可以设置Application.DisplayAlerts属性值为False，使复制时不出现该消息框。

        第2行代码通常复制单元格区域的操作不会将单元格区域的列宽大小同时复制，如果希望在复制单元格区域的同时，也复制源区域的列宽大小，可以使用下面的代码。

2. #001  Sub CopyWithSameColumnWidths()
   
3. #002      Sheet1.Range("A1").CurrentRegion.Copy
   
4. #003      With Sheet3.Range("A1")
   
5. #004          .PasteSpecial xlPasteColumnWidths
   
6. #005          .PasteSpecial xlPasteAll
   
7. #006      End With
   
8. #007      Application.CutCopyMode = False
   
9. #008  End Sub

#001  Sub CopyWithSameColumnWidths()<br /> #002      Sheet1.Range("A1").CurrentRegion.Copy<br /> #003      With Sheet3.Range("A1")<br /> #004          .PasteSpecial xlPasteColumnWidths<br /> #005          .PasteSpecial xlPasteAll<br /> #006      End With<br /> #007      Application.CutCopyMode = False<br /> #008  End Sub

代码解析：
        第4行代码使用Range对象的PasteSpecial方法选择性粘贴剪贴板中的Range对象的列宽。
        第5行代码粘贴剪贴板中的Range对象全部内容。
        第7行代码取消应用程序复制模式。
        应用于Range对象的PasteSpecial方法将剪贴板中的Range对象粘贴到指定区域，在粘贴时可以有选择的粘贴对象的部分属性。其语法如下：
PasteSpecial(Paste, Operation, SkipBlanks, Transpose)
        参数Paste指定要粘贴的区域部分，可为表格所列的XlPasteType常量之一。

        参数Operation指定粘贴操作。可为表格所列的XlPasteSpecialOperation常量之一。

        参数SkipBlanks指示是否跳过空单元格，若参数值为True，则不将剪贴板上区域中的空白单元格粘贴到目标区域中。默认值为False。
        参数Transpose指示是否进行转置，若参数值为True，则粘贴区域时转置行和列。默认值为False。
        运行CopyWithSameColumnWidths过程后，Sheet3工作表如图所示，目标区域的各列列宽与源区域一致。

注意 使用PasteSpecial方法时指定xlPasteAll(粘贴全部)，不会粘贴列宽。

[ 本帖最后由 yuanzhuping 于 2009-2-16 23:00 编辑 ]

henrych

班主，最近在想办法把日常office的工作通过vba实现，发现这个论坛正是我想要的。
想问一下斑竹：什么时候介绍一下如何使用vba实现动态修改图表(chart)中的数据源的方法？

yuanzhuping

原帖由 henrych 于 2009-2-10 16:29 发表
班主，最近在想办法把日常office的工作通过vba实现，发现这个论坛正是我想要的。
想问一下斑竹：什么时候介绍一下如何使用vba实现动态修改图表(chart)中的数据源的方法？

在Shape（图形）与Chart（图表）对象这部分中有这方面的内容。

henrych

班主，最近在想办法把日常office的工作通过vba实现。想问一下如何使用vba实现动态修改图表(chart)中的数据源？
即：有很多图表，每个图表的数据源都是来自各个不同SHEET中的相同的数据列，而各个SHEET中的数据行会定期自动追加，想通过VBA实现，点一个按钮，图表中的数据源就自动更新包含追加的数据。
劳烦斑竹指点一二，谢谢！

yuanzhuping

技巧8         仅复制数值到另一区域
       如果在复制单元格区域时，仅希望复制单元格区域的数值，有下面几种方法。
8-1        使用选择性粘贴
       使用选择性粘贴功能并指定粘贴数值，如下面的代码所示。

2. #001  Sub CopyPasteSpecial()
   
3. #002      Sheet1.Range("A1").CurrentRegion.Copy
   
4. #003      Sheet2.Range("A1").PasteSpecial Paste:=xlPasteValues
   
5. #004      Application.CutCopyMode = False
   
6. #005  End Sub

#001  Sub CopyPasteSpecial()<br /> #002      Sheet1.Range("A1").CurrentRegion.Copy<br /> #003      Sheet2.Range("A1").PasteSpecial Paste:=xlPasteValues<br /> #004      Application.CutCopyMode = False<br /> #005  End Sub

代码解析：
       CopyPasteSpecial过程复制工作表Sheet1中A1单元格的当前区域的数值到工作表Sheet2的A1单元格所在区域中。
       第2行代码将如图所示的Sheet1中A1单元格的当前区域进行复制。

       第3行代码使用选择性粘贴功能并指定粘贴数值，选择性粘贴数值仅复制了单元格区域的数值，单元格区域的格式（背景颜色、字体对齐格式和边框等）不会被复制，复制结果如图所示。

8-2        直接赋值的方法
       除了使用Copy方法外，还可以使用直接赋值的方法，如下面的代码所示。

2. #001  Sub GetValueResize()
   
3. #002      With Sheet1.Range("A1").CurrentRegion
   
4. #003          Sheet3.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
   
5. #004      End With
   
6. #005  End Sub

#001  Sub GetValueResize()<br /> #002      With Sheet1.Range("A1").CurrentRegion<br /> #003          Sheet3.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value<br /> #004      End With<br /> #005  End Sub

代码解析：
       GetValueResize过程将工作表Sheet1中的A1单元格的当前区域的数值赋予工作表Sheet3的A1单元格所在的单元格区域。
       在对单元格区域直接赋值时，应保证源区域大小与目标区域的大小一致，如果源区域为动态的单元格区域，可使用Resize方法确定目标区域。
       运行GetValueResize过程，赋值结果如上图所示。

[ 本帖最后由 yuanzhuping 于 2009-2-16 22:11 编辑 ]

henrych

斑竹回复这么快啊，谢谢，我看看去。