vba字典合并单元格为空_用VBA在Excel中分解合并单元格的代码范例

1

用

VBA

在

Excel

中分解合并单元格的代码范例：

Sub

分解合并单元格并填充

()

Set

已选择的区域

= Selection

首行

=

已选择的区域

.Row

行数

=

已选择的区域

.Rows.Count

If

首

行

+

行

数

-

1

=

65536

Then

行

数

=

ActiveSheet.UsedRange.Row

+

ActiveSheet.UsedRange.Rows.Count -

首行

+ 1

首列

=

已选择的区域

.Column

列数

=

已选择的区域

.Columns.Count

For

列

=

首列

To

首列

+

列数

- 1

Set

单元格

= Cells(

首行

,

列

)

行

=

首行

While

单元格

.Row <

首行

+

行数

If

单元格

.MergeCells Then

Set

合并区

=

单元格

.MergeArea

合并区

.UnMerge

If

合并区

.Rows.Count > 1 Then

合并区

.FillDown

行

=

行

+

合并区

.Rows.Count

Else

行

=

行

+ 1

End If

Set

单元格

= Cells(

行

,

列

)

Wend

Next

End Sub

Sub

合并相同的单元格

()

Dim Rng As Range, Dic As Object, Arr, N&

Set Dic = CreateObject("scripting.dictionary")

'

创建字典项目

For Each Rng In Range("b2:b" & Cells(Rows.Count, 2).End(3).Row)

'

循环

B

列要处理的数据区

If Rng <> "" Then

'

如果单元格不为空

,

则

If

Dic.exists(Rng.Value)

Then

'

如果已存在该单元格内容对应的字典项目

,

则将当前单元格与已存

在内容进行组合

Set Dic(Rng.Value) = Union(Dic(Rng.Value), Rng)

Else

'

否则进行添加

Set Dic(Rng.Value) = Rng

End If

End If

Next Rng

If Dic.Count > 0 Then

'

如果字典项目数大于

0,

则

Arr = Dic.keys

'

将字典的

key

赋值给数组

Application.DisplayAlerts

=

False

'

关闭警告信息

(

合并单元格时会弹出警告信息

,

通过此命令禁止弹出

该信息

)