VBA常用技巧代码解析

yuanzhuping

技巧15         合并单元格操作
15-1        判断单元格区域是否存在合并单元格
       Range对象的MergeCells属性可以确定单元格区域是否包含合并单元格，如果该属性返回值为True，则表示区域包含合并单元格。
       下面的代码判断单元格 A1是否包含合并单元格，并显示相应的提示信息。

1. #001  Sub IsMergeCell()
   
2. #002      If Range("A1").MergeCells = True Then
   
3. #003          MsgBox "包含合并单元格"
   
4. #004      Else
   
5. #005          MsgBox "没有包含合并单元格"
   
6. #006      End If
   
7. #007  End Sub
   
8.        如果在指定区域中

复制代码

存在部分合并的单元格，比如如图所示的工作表区域E8:I17中包含合并单元格区域F8:G9，H12:I13。

       判断这样一个单元格区域中是否包含合并单元格，可以使用下面的代码快速判断单元格区域中是否包含部分合并单元格，而不需要遍历单元格。

1. #001  Sub IsMerge()
   
2. #002      If IsNull(Range("E8:I17").MergeCells) Then
   
3. #003          MsgBox "包含合并单元格"
   
4. #004      Else
   
5. #005          MsgBox "没有包含合并单元格"
   
6. #006      End If
   
7. #007  End Sub

复制代码

代码解析：
       当单元格区域中同时包含合并单元格和非合并单元格时，MergeCells属性将返回Null，因此第2行代码通过该返回结果作为判断条件。
       运行IsMerge过程结果如图所示。


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

yuanzhuping

技巧15         合并单元格操作
15-2        合并单元格时连接每个单元格的文本
       使用Excel的“合并及居中”按钮合并多个单元格区域时，Excel仅保留区域左上角单元格的内容，如果用户希望在合并如图所示单元格区域时，将各个单元格的内容连接起来保存在合并后的单元格区域中，则可以使用下面的代码。

1. #001  Sub Mergerng()
   
2. #002      Dim StrMerge As String
   
3. #003      Dim rng As Range
   
4. #004      If TypeName(Selection) = "Range" Then
   
5. #005          For Each rng In Selection
   
6. #006              StrMerge = StrMerge & rng.Value
   
7. #007          Next
   
8. #008          Application.DisplayAlerts = False
   
9. #009          Selection.Merge
   
10. #010          Selection.Value = StrMerge
    
11. #011          Application.DisplayAlerts = True
    
12. #012      End If
    
13. #013  End Sub

复制代码

代码解析：
       Mergerng过程将所选各个单元格的内容连接起来保存在合并后的单元格区域中。
       第4行代码使用TypeName函数判断当前选定对象是否为Range对象，若是则继续执行代码。
       第5行到第7行代码将当前选中区域的内容连接起来保存在字符串变量StrMerge中。
       第8行代码将DisplayAlerts属性设置为False，禁止在合并多重数值区域时，Excel显示的警告信息，避免中断代码的运行。
       第9行代码使用Merge方法合并当前选定区域。应用于Range对象的Merge方法通过指定Range对象创建合并单元格，语法如下：
expression.Merge(Across)
       参数expression是必需的，返回一个Range对象。
       参数Across是可选的，如果该值为True，则将指定区域内的每一行合并为一个合并单元格。默认值为False。
       第9行也可以使用下面的代码：
Selection.MergeCells = True
       第10行代码将变量StrMerge的值赋给合并后的单元格。
       运行Mergerng过程结果如图所示。


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

yuanzhuping

技巧15         合并单元格操作
15-3        合并内容相同的连续单元格
       如果需要合并如图所示的工作表中B列中部门相同的连续单元格，可以使用下面的代码。

1. #001  Sub Mergerng()
   
2. #002      Dim IntRow As Integer
   
3. #003      Dim i As Integer
   
4. #004      Application.DisplayAlerts = False
   
5. #005      With Sheet1
   
6. #006          IntRow = .Range("A65536").End(xlUp).Row
   
7. #007          For i = IntRow To 2 Step -1
   
8. #008              If .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then
   
9. #009                  .Range(.Cells(i - 1, 2), .Cells(i, 2)).Merge
   
10. #010              End If
    
11. #011          Next
    
12. #012      End With
    
13. #013      Application.DisplayAlerts = True
    
14. #014  End Sub

复制代码

代码解析：
       第7行到第11行代码，从最后一行开始，向上逐个单元格判断连续两个单元格的内容是否相同，如果相同则合并。
       运行Mergerng过程后，结果如图所示。


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

yuanzhuping

技巧15         合并单元格操作
15-4        取消合并单元格时在每个单元格中保留内容
       如果需要取消技巧15-3中工作表B列“部门”的合并单元格，并且各个单元格均保留原合并单元格的内容，可以使用下面的代码。

1. #001  Sub UnMerge()
   
2. #002      Dim StrMer As String
   
3. #003      Dim IntCot As Integer
   
4. #004      Dim i As Integer
   
5. #005      With Sheet1
   
6. #006          For i = 2 To .Range("B65536").End(xlUp).Row
   
7. #007              StrMer = .Cells(i, 2).Value
   
8. #008              IntCot = .Cells(i, 2).MergeArea.Count
   
9. #009              .Cells(i, 2).UnMerge
   
10. #010              .Range(.Cells(i, 2), .Cells(i + IntCot - 1, 2)).Value = StrMer
    
11. #011              i = i + IntCot - 1
    
12. #012          Next
    
13. #013      End With
    
14. #014  End Sub

复制代码

代码解析：
       UnMerge过程取消工作表中B列中的合并单元格，并且各个单元格均保留原合并单元格的内容。
       第7行代码取得B列每个合并单元格的内容。
       第8行代码取得合并区域的单元格数量。
       第9行代码使用UnMerge方法取消合并单元格。UnMerge方法将合并区域分解为独立的单元格，语法如下：
expression.UnMerge
       第10行代码将原合并单元格的内容赋值给取消合并单元格后的区域。
       第11行代码调整循环变量i的值，使下一次循环从下一个单元格区域开始。
       运行UnMerge过程结果如图所示。


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

jameswzd

谢谢楼主无私的奉献

yql4688

这个代码解析非常好，对像我这样的更好

gljzyp

学习一下!!!收起来

yinjianxiong

很好,先收下啦

humengqiang

谢谢版主，正是我们这种初学者所需要的，边下载边学习

yuanzhuping

技巧16         高亮显示单元格区域
       如果希望以某种方式突出显示活动单元格或者指定的单元格区域，从而一目了然地获得某些信息，那么可以高亮显示活动单元格区域，如下面的代码所示。

1. #001  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. #002      Cells.Interior.ColorIndex = xlColorIndexNone
   
3. #003      Target.Interior.ColorIndex = 8
   
4. #004  End Sub

复制代码

代码解析：
       设置工作表当前选定区域单元格的内部填充颜色，以高亮显示选定区域，如图所示。

       第2行代码将工作表中所有的单元格的内部填充颜色设置为xlColorIndexNone，即取消单元格的内部填充颜色。
       第3行代码将工作表中选定单元格的内部填充颜色设置为8。
       应用于Interior对象的ColorIndex属性返回或设置边框内部的颜色。该颜色可指定为当前调色板中颜色的编号（请参阅技巧11-1）或为 XlColorIndex 常量之一：xlColorIndexAutomatic（指定对图形对象自动填充）、xlColorIndexNone（用于指定无内部填充）。
       还可以高亮显示指定区域内的行列，如下面的代码所示。

1. #001  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. #002      Dim rng As Range
   
3. #003      Cells.Interior.ColorIndex = xlNone
   
4. #004      Set rng = Application.Union(Target.EntireColumn, Target.EntireRow)
   
5. #005      rng.Interior.ColorIndex = 24
   
6. #006  End Sub

复制代码

代码解析：
       设置工作表当前选定区域单元格内部填充颜色，高亮显示活动单元格所在的行列，如图所示。

       第4行代码使用Union方法将所选单元格所在的行、列连接起来成为一个区域，关于Union方法请参阅技巧1-6。
注意 使用此方法时，工作表中所有设置的单元格内部填充颜色将会被清除。（不包括通过条件格式设置的单元格内部填充颜色），同时无法在工作表中实现复制粘贴功能。

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