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

Range.Merge 方法：由指定的Range对象创建合并单元格
 
（一）对选择的区域进行合并
 
Sub 合并单元格()
 
       Selection.Merge              '对选中的单元格区域执行此段代码，进行合并，仅保留左上角值
 
End Sub
 
**********************
 
（二）对相同相邻单元格进行合并
 
原料如下：
 

 

  

   
部门
   
职工
   
职级
  
  

   
1部门
  
 

合并单元格之前要提前将数据列排序好，然后再复制以下代码，运行宏程序。
 
批量合并单元格
 
Sub RngMergeCondition() '批量合并单元格
    Dim rngUser As Range
    Dim rngMerge As Range
    Dim rngSelect As Range
    Dim i As Long, j As Long
    Dim lngRowFirst As Long
    Dim lngClnFirst As Long
    Dim arr As Variant
    Dim brr As Variant
    Dim strTemp As String
    Dim lngBK As Long
    Dim shtUser As Worksheet
    On Error Resume Next
    Set rngSelect = Selection
    Set rngUser = Application.InputBox("请选择需要合并的单元格区域！", Default:=rngSelect.Address, Type:=8)
    Set rngUser = Intersect(rngUser.Parent.UsedRange, rngUser)
    '使用Intersect规避用户选择整列数据
    If rngUser Is Nothing Then MsgBox "选择的单元格区域不能为空白": Exit Sub
    arr = rngUser.Value
    ReDim brr(1 To UBound(arr), 1 To 2)
    '结果数组，第一列保存值，第二列保存合并行数
    For i = 1 To UBound(arr)
        strTemp = ""
        For j = 1 To UBound(arr, 2)
            strTemp = strTemp & "@@" & arr(i, j)
            '合并多列字符串为单个字符串
        Next
        brr(i, 1) = strTemp
        '字符串装入结果数组
        If i > 1 Then
        '如果不是第一行
            If brr(i - 1, 1) = strTemp Then
                If lngBK = 0 Then lngBK = i - 1
                'lngBK变量赋值结果数组用于存放合并行数的位置
                brr(lngBK, 2) = brr(lngBK, 2) + 1
                '累计相同值的行数
            Else
                lngBK = i
            End If
        End If
    Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    lngRowFirst = rngUser.Row
    '用户选择单元格区域的开始行
    lngClnFirst = rngUser.Column
    '用户选择单元格区域的开始列
    Set shtUser = rngUser.Parent
    For i = 1 To UBound(brr)
        If brr(i, 2) > 0 Then
            For j = 1 To UBound(arr, 2)
                Set rngMerge = shtUser.Cells(i + lngRowFirst - 1, lngClnFirst + j - 1)
                rngMerge.Resize(brr(i, 2) + 1, 1).Merge
            Next
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
批量撤销合并单元格
 
Sub unMergeRng() '撤销合并单元格
    Dim rngUser As Range
    Dim rngMerge As Range
    Dim lngRowFirst As Long
    Dim lngRowEnd As Long
    Dim lngClnFirst As Long
    Dim lngColEnd As Long
    Dim lngRowMerge As Long
    Dim i As Long
    Dim j As Long
    Dim rngSelect As Range
    On Error Resume Next
    Set rngSelect = Selection
    '用户初始选择的单元格
    Set rngUser = Application.InputBox("请选择需要撤销合并的单元格区域！", Default:=rngSelect.Address, Type:=8)
    '用户选择需要撤销合并的单元格区域
    Set rngUser = Intersect(rngUser.Parent.UsedRange, rngUser)
    'Intersect避免用户选择整列等单元格范围时，程序运算数据虚大，运算效率低下
    If rngUser Is Nothing Then MsgBox "选择的单元格区域不能为空白": Exit Sub
    lngRowFirst = rngUser.Row
    '运算范围的初始行
    lngRowEnd = lngRowFirst + rngUser.Rows.Count - 1
    '运算范围的结束行
    lngClnFirst = rngUser.Column
    '运算范围的开始列
    lngColEnd = lngClnFirst + rngUser.Columns.Count - 1
    '运算范围的结束列
    Application.ScreenUpdating = False
    For i = lngRowFirst To lngRowEnd
    '遍历行
        For j = lngClnFirst To lngColEnd
        '遍历列
            lngRowMerge = Cells(i, j).MergeArea.Rows.Count
            '合并单元格的行数
            If lngRowMerge > 1 Then
                With Cells(i, j).Resize(lngRowMerge, 1)
                    .Select
                    .UnMerge
                    '撤销合并
                    .Value = Cells(i, j)
                    '填充数据
                End With
            End If
        Next
        i = i + lngRowMerge - 1
        '跳过已处理完的合并行
    Next
    rngSelect.Select
    Application.ScreenUpdating = True
End Sub

        最近的项目中，用到了很多Excel的VBA宏功能，用户的新需求也有很多需要用VBA宏来实现。为满足业务需求，
 
自己搜索网上的相关资料，尝试不同的解决方法，最终解决了用户的需求，在此记录下来，做一个总结，也希望能给
 
别的网友有所帮助。
 
        首先用户的第一个需求，是Excel WorkSheet中原有的行不可删除，只能修改某些栏位。用户可以新插入行，而新插入
 
的行可以删除。如下图所示：
 
 
         2001，2002，2003和2004四行数据 不允许删除，而Inserted这行数据是后来插入的，可以删除。
 
        Excel可以整个sheet锁定，却没有按行锁定，而且即使能按行锁定，由于存在插入删除，行序会动态变化，
 
锁定位置也无法固定。所以必须用锁定以外的方法来解决。
 
        首先想到的就是监听Worksheet的插入和删除事件。如果插入删除都有响应事件，那在事件中做拦截处理就
 
很容易实现功能了。可惜的是，Excel虽然功能无比强大，但是worksheet的响应事件却并不丰富，仅有一个change
 
事件，能响应所有的worksheet中改变内容的操作，其他事件似乎都不太有用：
 
 
 
         还好，在网上搜到了在这个事件中判断整行插入和删除的方法：
 
         '选择了一整行
         If Target.Address Like "$#*:$#*" Then
 
        但是这只能判断出是整行选择，至于是插入还是删除，就得自己去区别处理了。
 
         插入比较简单，Target.row所指向的是一个空行，而且已经存在于Excel中了，所以直接判断第一个单元格为空就好：
 
          '如果TargetRow的第一列值为空，且不是最后一行，说明是插入
             'Sheet1.UsedRange.Row 表示有数据的开始行序，Sheet1.UsedRange.Rows.Count 表示有数据的行数，二者相加就是最后一行序
             If (Trim(Sheet1.Cells(Target.Row, 1).Value) = "" And _
                 Target.Row <> (Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count)) Then
 
          之所以要区分是否最后一行，因为在最后一行插入时，插入前选中的行也就是插入位置本身就是空行，而在其他位置插入，
 
插入位置不是空行，所以需要特别区分。
 
         而删除操作就比较麻烦，因为Worksheet_change的Target参数中，没有任何关于被删除行的信息，而且当事件发生时，删除行
 
已经从Excel中移除，Target.row指向的是一个新行。所以就需要提前把删除行的信息在选择事件中记录下来：
 
'在Slection change 事件中，保存选择的行号和第一列的值
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     selectedRow = Target.Row
     selectedId = Sheet1.Cells(Target.Row, 1).Value
 End Sub
 
          这样，在change事件中，就可以取得删除行的selectedId，如果是新插入的数据，第一列值就是Inserted，可以删除；否则，就是
 
原有的数据，不允许删除：
 
 
       当然，要完整实现用户功能，还需要增加一些完善措施，例如多行选中的剔除：
 
       '如果选择多于一行
     If (Selection.Rows.Count > 1) Then
         MsgBox "Only allowed select one row"
         Application.Undo
     Else
 
       还有禁止首行插入，首列标记的约定等。具体可以看实现代码。
 
       第二个需求是插入单元格后，能自动合并。如下图所示：
 
  
 
     插入新城市之后，省份要自动合并。这里，继续沿用上面的方法，在Worksheet的change事件中，进行处理：
 
 
           这里只处理了插入行的合并，对于删除行需要的合并，可以参照第一个需求，采用首列标记的做法来区别处理。
 
           合并单元格时，需要区分插入的位置，合并单元格中间插入的，无需合并；合并单元格末尾插入的，需要调整
 
合并单元格大小；而在整个表格最后插入的，除了调整合并单元格大小外，还需要绘制边框。
 
            这里引用到了在模块中定义的三个方法：findLastRow 找到当前数据的最后一行，findPrevMerge 找到需要合并
 
的单元格，setRangeBorder 设置Range的边框：
 
 
         第三个需求，是需要设定单元格的条件公式自动计算。具体如下图所示：
 
 
           支出部分各个项目的值，要根据相应的收入部分，按比例拆分。例如，对于200801列，项目1的支出应该是1500 *
 
1000 /(1000+900+1500)。200802没有收入，就按收入总额的占比进行拆分，所以项目1在200802的支出应该是3000*3000/
 
(3000+2000+5000)。上部分收入数据发生改变后，下部分支出数据要自动拆分，所以决定用单元格的宏公式来实现。
 
           首先定义一个方法：
 
        '设置Sheet3的动态公式
         Sub setDynamicFormula()
 
         当然，需要先定义一个公用方法findNext，去找到收入和支出合并单元格的range，后面设定公式时，会用到这两个
 
range对象。
 
         获取收入的range后，可以拼出汇总total收入和当期收入的公式：
 
    Set revRng = findNext(Sheet3, categoryCol, titleRow + 1, "收入")
      '汇总Total的公式
     sumTotal = "SUM(R" & revRng.Row & "C" & totalCol & ":R" & (revRng.Row + revRng.Rows.Count - 1) & "C" & totalCol & ")"
      '汇总收入的公式
     sumRev = "SUM(R" & revRng.Row & "C:R" & (revRng.Row + revRng.Rows.Count - 1) & "C)"
 
     汇总Total收入，指定的行是收入Range的所有行，列是收入Total所在列，都是绝对引用。
 
     汇总当期收入，行一样，列只有C，意味着取要设定公式的单元格的列。
 
     最后，循环对支出Range所在行的所有期间列的支出单元格，设定计算公式：
 
       For i = totalCol + 1 To Sheet3.UsedRange.Column + Sheet3.UsedRange.Columns.Count - 1
         For j = 0 To costRng.Rows.Count - 1
             Sheet3.Cells(costRng.Row + j, i).NumberFormatLocal = "#######.00" '保留两位小数
       
             '如果当前收入为空或为0，采用总收入占比拆分，否则用当前收入占比拆分
             Sheet3.Cells(costRng.Row + j, i).FormulaR1C1 = "=IF(OR(R[-" & rowOffset & "]C="""",R[-" & rowOffset & "]C=0)," & _
                      "R[-" & rowOffset & "]C" & totalCol & "/" & sumTotal & "*R" & totalCostRow & "C," & _
                      "R" & totalCostRow & "C*R[-" & rowOffset & "]C/" & sumRev & ")"
                      
              Sheet3.Cells(costRng.Row + j, i).Locked = True
         Next j
     Next i   
 
     在这里，当前期收入的行，采用的是相对引用，当前收入的列，直接采用单元格的值，而totalCost的行，及total收入的列，
 
则都采用的绝对引用。
 
     最后，把setDynamicFormula()方法加入到workbook的open事件中，当Excel打开时，就会自动实现单元格计算公式的赋值。
 
     
 
      示例Excel宏文件已经上传CSDN：http://download.csdn.net/download/yangdanbo1975/10205254
 
      由于本人是第一次搞VBA宏，水平有限，如有不妥或不完善之处，还欢迎各位网友不吝赐教，以利共同提高。