2024年4月24日发(作者：)

EXCEL中如何用VBA判断某一地址单元格是否为合并单元格？如果是，则其为几列几行合并

而成？

最佳答案 Sub myMerge()

Set cel = Range("A1")

If ells Then MsgBox s(0, 0) & "为合并单元格，" & "共有" &

& "行" & & "列组成"

End Sub

1、判断单元格区域是否存在合并单元格

Range对象的MergeCells属性可以确定单元格区域是否包含合并单元格，如果该属性返回

值为True，则表示区域包含合并单元格。

下面的代码判断单元格 A1是否包含合并单元格，并显示相应的提示信息。

1.

2.

3.

4.

5.

6.

7.

Sub IsMergeCell()

If Range("A1").MergeCells = True Then

MsgBox "包含合并单元格"

Else

MsgBox "没有包含合并单元格"

End If

End Sub

复制代码

如果在指定区域中存在部分合并的单元格，如图 1所示，区域E8:I17中包含合并单元格区

域F8:G9，H12:I13。判断这样一个单元格区域中是否包含合并单元格，可以使用下面的代

码快速判断单元格区域中是否包含部分合并单元格，而不需要遍历单元格。

图 1 包含部分合并单元格的区域

1.

2.

3.

4.

5.

6.

7.

Sub IsMerge()

If IsNull(Range("E8:I17").MergeCells) Then

MsgBox "包含合并单元格"

Else

MsgBox "没有包含合并单元格"

End If

End Sub

复制代码

代码解析：

当单元格区域中同时包含合并单元格和非合并单元格时，MergeCells属性将返回Null，因

此第2行代码通过该返回结果作为判断条件。

运行IsMerge过程结果如图 15 2所示。

图 2 提示信息

2、合并单元格时连接每个单元格的文本

使用Excel的“合并及居中”按钮合并多个单元格区域时，Excel仅保留区域左上角单元格

的内容，如果用户希望在合并如图 15 3所示单元格区域时，将各个单元格的内容连接起来

保存在合并后的单元格区域中，则可以使用下面的代码。

图 3 合并前单元格区域

1. Sub Mergerng()

2. Dim StrMerge As String

3. Dim rng As Range

4. If TypeName(Selection) = "Range" Then

5. For Each rng In Selection

6. StrMerge = StrMerge &

7. Next

8. yAlerts = False

9.

10. = StrMerge

11. yAlerts = True

12. End If

13. End Sub

复制代码

代码解析：

Mergerng过程将所选各个单元格的内容连接起来保存在合并后的单元格区域中。

第4行代码使用TypeName函数判断当前选定对象是否为Range对象，若是则继续执行代码。

第5行到第7行代码将当前选中区域的内容连接起来保存在字符串变量StrMerge中。

第8行代码将DisplayAlerts属性设置为False，禁止在合并多重数值区域时，Excel显示

的警告信息，如图 4所示，以避免中断代码的运行。

图 4 合并多重数值区域时警告信息

第9行代码使用Merge方法合并当前选定区域。应用于Range对象的Merge方法通过指定

Range对象创建合并单元格，语法如下：

(Across)

参数expression是必需的，返回一个Range对象。

参数Across是可选的，如果该值为True，则将指定区域内的每一行合并为一个合并单元格。

默认值为False。

第9行也可以使用下面的代码：

ells = True

第10行代码将变量StrMerge的值赋给合并后的单元格。

运行Mergerng过程结果如图 5所示。

图 5 合并单元格结果

3、合并内容相同的连续单元格

如果需要合并如图 6所示的工作表中B列中部门相同的连续单元格，可以使用下面的代码。

图 6 需合并的工作表

1. Sub Mergerng()

2. Dim IntRow As Integer

3. Dim i As Integer

4. yAlerts = False

5. With Sheet1

6. IntRow = .Range("A65536").End(xlUp).Row

7. For i = IntRow To 2 Step -1

8. If .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then

9. .Range(.Cells(i - 1, 2), .Cells(i, 2)).Merge

10. End If

11. Next

12. End With

13. yAlerts = True

14. End Sub

复制代码

代码解析：

第7行到第11行代码，从最后一行开始，向上逐个单元格判断连续两个单元格的内容是否

相同，如果相同则合并。

运行Mergerng过程后，结果如图 7所示。

图 7 合并内容相同的连续单元格

4、取消合并单元格时在每个单元格中保留内容

如果需要取消如图 7所示的工作表中B列“部门”的合并单元格，并且各个单元格均保留

原合并单元格的内容，可以使用下面的代码。

1.

2.

3.

4.

Sub UnMerge()

Dim StrMer As String

Dim IntCot As Integer

Dim i As Integer

5. With Sheet1

6. For i = 2 To .Range("B65536").End(xlUp).Row

7. StrMer = .Cells(i, 2).Value

8. IntCot = .Cells(i, 2).

9. .Cells(i, 2).UnMerge

10. .Range(.Cells(i, 2), .Cells(i + IntCot - 1,

2)).Value = StrMer

11. i = i + IntCot - 1

12. Next

13. End With

14. End Sub

复制代码