在Excel表格里,合并单元格会给使用过程带来很多麻烦,但是有时候为了排版好看,又需要用到合并的功能。
特别是有时候从外部收集到的表格,总有人喜欢使用合并单元格!
有时候做数据处理的时候,会碰上一些因为合并单元格而造成的问题:
这种情况,取消合并单元格就能够解决问题。
但是,如果表格数据较多,靠眼睛去看,要想很快的找到合并单元格就没那么容易了。
让我们看看用VBA如何来实现一个快速定位合并单元格的功能,效果:
首先在customUI.xml中修改代码,因为前面有2个合并单元格相关的功能,所以都放到一个下拉菜单里面:
代码语言:javascript复制 <menu id="rbmenuMergeRange" label="合并单元格 " size="large" imageMso="ViewSlideSorterView">
<button id="rbbtnMergeRange" label="合并单元格与文本" supertip="合并单元格,同时合并所有单元格的文本" onAction="rbbtnMergeRange" imageMso="ReviewCombineRevisions"/>
<button id="rbbtnUnMergeRange" label="取消合并" supertip="取消单元格合并,并填充文本" onAction="rbbtnUnMergeRange" imageMso="CreateDiagram"/>
<button id="rbbtnSelectMergeRange" label="定位合并单元格" onAction="rbbtnSelectMergeRange" imageMso="ZoomToSelection" />
</menu>
回调函数:
代码语言:javascript复制Sub rbbtnSelectMergeRange(control As IRibbonControl)
Call MRange.SelectMergeRange
End Sub
函数实现:
最简单的也最容易想到的方法自然是直接循环判断选择单元格中的每一个单元格是否是合并的,找到了就可以停止下来并选中:
代码语言:javascript复制'选中合并单元格
Sub SelectMergeRange()
Dim rng As Range, selectRng As Range
'确保选中的是单元格
If TypeName(Selection) = "Range" Then
Set selectRng = Selection
For Each rng In selectRng
If rng.MergeCells Then
rng.Select
Exit Sub
End If
Next rng
End If
Set rng = Nothing
Set selectRng = Nothing
End Sub
可是,如果表格太大,循环去判断会有点慢,怎么去加快速度?
Excel用的多的,应该能够注意到,如果选中了合并单元格,开始菜单的合并单元格那个按钮会变化,这就是提醒使用者当前选中的是合并单元格。
而这个变化,其实只要选择的单元格中含有合并单元格就会出现,所以根据这个特性,我们去查找VBA中对应的这种属性,其实就是MergeCells属性,点击F1查看官方文档:
如果区域内包含合并单元格,此属性的值为 True。 读/写 Variant。
我们可以在立即窗口中去测试这个属性:
代码语言:javascript复制?Selection.MergeCells
- 如果选中的是合并单元格,返回True
- 如果选中的不含合并单元格,返回False
- 如果选中的单元格中,既有合并单元格、又有正常的非合并单元格,返回Null
根据返回Null的那个特性,我们就可以不需要一个一个的去判断了,比如可以整列整列的判断,这样查找起来就会快很多:
代码语言:javascript复制'选中合并单元格
Sub SelectMergeRange()
Dim rng As Range, selectRng As Range
Dim cols As Long, i As Long
'确保选中的是单元格
If TypeName(Selection) = "Range" Then
Set selectRng = Selection
cols = selectRng.Columns.Count
For i = 1 To cols
'先按列来判断是否包含了合并单元格
If VBA.IsNull(selectRng.Columns(i).MergeCells) Then
'再判断列里面的每一个单元格
For Each rng In selectRng.Columns(i).Cells
If rng.MergeCells Then
rng.Select
Exit Sub
End If
Next
End If
Next
End If
Set rng = Nothing
Set selectRng = Nothing
End Sub