Excel VBA中单元格的合并与拆分

最新推荐文章于 2025-10-14 09:19:26 发布

原创最新推荐文章于 2025-10-14 09:19:26 发布 · 1.6w 阅读

31 ·

CC 4.0 BY-SA版权

文章标签：

#Excel VBA中单元格的合并与拆分

EXCEL VBA 专栏收录该内容

4 篇文章

订阅专栏

本文介绍使用VBA在Excel中实现单元格的合并与拆分操作，包括从上到下和从下到上的合并方法，以及拆分后的填充处理，适用于批量数据处理，提高工作效率。

对于合并单元格这里提供”从上到下“和“从下到上”合并单元格两种方式，”从上到下“的方法需要记录当前列有多少个相同的单元格和判断相应的单元格是否是合并单元格，过程相对来说繁琐一些，“从下到上”的方法则相对简单一些，代码量相对来说也比较少。
1.”从上到下“的方法

Sub 从上到下合并单元格()
'
Dim i, l, m As Integer
'禁止弹出提示的对话框
Application.DisplayAlerts = False

k% = InputBox("请输入合并单元格所在的列")

'*****************在1995-2006年，excel工作簿包含65536行，但现在的office 2007中工作簿包含1048576行,
'*****************从A列最后一行向上找，找到有数据的行为止
 l = [A65536].End(xlUp).Row      'l记录当前表格的最后一行的行数
 
 For i = 1 To l
  
'判断该单元格是否是合并单元格

If Cells(i, k).MergeCells = True Then    
     If Cells(i - m, k) = Cells(i + 1, k) Then     
      m = m + 1                               'M代表一个有多少个相同的单元格   
    Else  
         m = 0
    End If
Else
         m = 0
      If Cells(i, k) = Cells(i + 1, k) Then  
        m = m + 1
      End If
End If 
  Range(Cells(i, k), Cells(i + m, k)).Merge
 Next
 Application.DisplayAlerts = True
 End Sub

2.”从下到上“的方法

Sub 从下到上合并单元格()
Dim i, l As Integer
'禁止弹出提示的对话框
Application.DisplayAlerts = False

k% = InputBox("请输入合并单元格所在的列")
'*****************在1995-2006年，excel工作簿包含65536行，但现在的office 2007中工作簿包含1048576行,
'*****************从A列最后一行向上找，找到有数据的行为止
 l = [A65536].End(xlUp).Row      'l记录当前表格的最后一行的行数
 
 For i = l To 2 Step -1
     If Cells(i, k) = Cells(i - 1, k) Then
      Range(Cells(i, k), Cells(i - 1, k)).Merge
    End If
 Next
  Application.DisplayAlerts = True  
End Sub

单元格的拆分
当单元格进行合并之后就是如何进行拆分，拆分和合并原理大致相似，就是先判断是否是合并单元格，然后获取合并单元格的数目，进行拆分和填充。相应代码如下：

Sub 拆分单元格()

Dim i, l, m As Integer

'禁止弹出提示的对话框
Application.DisplayAlerts = False

k% = InputBox("请输入拆分单元格所在的列")
'*****************在1995-2006年，excel工作簿包含65536行，但现在的office 2007中工作簿包含1048576行,
'*****************从A列最后一行向上找，找到有数据的行为止
 l = [A65536].End(xlUp).Row      'l记录当前表格的最后一行的行数
 For i = 1 To l
      '判断该单元格是否是合并单元格
       If Cells(i, k).MergeCells = True Then
          m = Cells(i, k).MergeArea.Count                           '记录合并单元格的个数
          Range(Cells(i, k), Cells(i + m - 1, k)).UnMerge      ‘拆分单元格
          Range(Cells(i, k), Cells(i + m - 1, k)).FillDown       ’填充单元格
          i = i + m - 1   
      End If    
 Next
  Application.DisplayAlerts = True
End Sub