【VBA】合并单元格 + 撤销合并单元格

合并单元格

原始表

希望效果

需要达到以上效果我们可以先分析一下我们在表中会如何操作：

• 1.对年级列进行排序
• 2.合并相同的年级列
• 3.合并总分列使其格式和年级列一致
• 4.将各个年级对应的分数进行累加

那么现在写出对应的VBA代码

• 1

整张表.sort 年级列，xlAscending , Header:=xlYes 

• 2

if cells(某行,某列).values = cells(某行 - 1,某列) then
	range(cells(某行,某列),cells(某行-1,某列)).Merge

• 3

range(cells(某行,某列),cells(某行-1,某列)).Merge

• 4

Cells(总分列) = Cells(总分列) + Cells(分数列).Value

• 完整代码

Sub 合并单元格()
Dim a, b As Integer, d As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'定位到最后一行
a = Cells(Rows.Count, "h").End(xlUp).Row
'对年级列进行排序
Set d = Range("h1").CurrentRegion
d.Sort Cells(2, "h"), xlAscending, Header:=xlYes
'对年级列进行合并
For b = a To 2 Step -1
'对数值进行累加
Cells(b, "j") = Cells(b, "j") + Cells(b, "i").Value
    If Cells(b, "h").Value = Cells(b - 1, "h").Value Then
        Range(Cells(b, "h"), Cells(b - 1, "h")).Merge
        Range(Cells(b, "j"), Cells(b - 1, "j")).Merge
    End If
Next b
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

还原表格，撤销和并单元格。

要做到撤销合并单元格，在excel里面需要进行以下操作
1. 撤销年级列合并单元格（撤销前需要判断是否是合并单元格）
2.使年级列的值等于撤销合并列后第一个单元格的值(除此之外还需要注意excel撤销合并单元格后，程序就无法判断这一个格是合并单元格了，就无法赋值了，所以这里还需要加一层逻辑判断。如果单元格没有值，它的值就是上一格单元格的值)
3. 撤销总分列合并单元格
4.使总分列的值等于空值

那么现在写出对应的VBA代码：

• 1

if cells(某行,年级列).MergeCells = True Then cells(某行,年级列).unmerge

• 2

if cells(某行,年级列) = " " Then cells(某行,年级列).value = cells(某行-1,年级列)

• 3

cells(某行,总成绩列).unmerge

• 4

cells(某行,总成绩列) = " "

• 完整代码

Sub 撤销合并单元格()
'判断是否是合并单元格
'如果是，将第一个单元格的值赋值给第二个
Dim a, b As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
a = Cells(Rows.Count, "h").End(xlUp).Row()
For b = 2 To a + 1
    '如果是合并单元格，撤销
    If Cells(b, "h").MergeCells = True Then _
    	'撤销年级列
        Cells(b, "h").UnMerge
        '撤销总分列
        Cells(b, "j").UnMerge
        '使总分列的值为空
        Cells(b, "j").Value = ""
        '如果没有值，这个单元格的值等于上一个值
    If Cells(b, "h") = "" Then
        Cells(b, "h").Value = Cells(b - 1, "h")
    End If
Next b
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub