• 2009-12-13

    Wps表格单元格保留数据合并与还原 - [WPS]

    版权声明:转载时请以超链接形式标明文章原始出处和作者信息及本声明
    http://www.blogbus.com/pptaddins-logs/53725791.html

    在Wps表格和Excel中保留数据合并单元格并还原数据是非常简单的,只需不到几十行的代码。闲话少说,直上代码。

    (1)合并单元格并保留数据

    Dim sRowContent() As String '用来保留单元格的数据,以便恢复

    ' sFlag:可选,默认为",表示在数据之间添加连接符,如:-
    ' bCenter:可选,默认为居中,表示合并后的单元格数据是否居中.
    ' Author:无极
    ' Blog:http://pptaddins.blogbus.com

    Sub MergeCell (Optional ByVal sflag As String="",Optional ByVal bCenter As Boolean = True)

      Dim Rng As Range
      Set Rng = ET.Application.Selection
      If Rng Is Nothing Then
         MsgBox "没有可合并的区域"
         GoTo done
      End If
     
      Dim Rw As ET.Range, Rc As Range
      Set Rw = Rng.EntireRow
      Set Rc = Rng.EntireColumn
     
      Dim i As Long, j As Long, str As String
      ReDim sRowContent(rw.Count - 1, rc.Count - 1) '分配数据空间
      ET.Application.DisplayAlerts = False '关闭警告

      For i = 1 To Rw.Count
          For j = 1 To Rc.Count
              sRowContent(i - 1, j - 1) = rng.Cells(i, j).Value
              str = str & rng.Cells(i, j).Value & sflag
          Next j
            str = Left(str, Len(str) - Len(sflag))
            str = str & vbCrLf  
      Next
      With Rng
          .MergeCells = True
         .Value = str
         if bCenter then
             .HorizontalAlignment=etHAlignCenter
             .VerticalAlignment=etVAlignCenter
        end if
      End With
    ET.Application.DisplayAlerts = True
    done:
    End Sub

    (2)取消合并且还原数据

    Sub UndoMergeCell ()

    Dim Rng As Range
    Set Rng = ET.Application.Selection
      If Rng Is Nothing Then
         MsgBox "没有可还原的区域"
         GoTo done
      End If

      With Rng
        .Clear
        .MergeCells = False
    End With

      Dim Rw As ET.Range, Rc As Range
      Set Rw = Rng.EntireRow
      Set Rc = Rng.EntireColumn
     
      Dim i As Long, j As Long, str As String  
      For i = 1 To Rw.Count
          For j = 1 To Rc.Count
              Rng.Cells(i, j).Value = sRowContent(i - 1, j - 1)
            Next j
      Next

    Done:

    End Sub

    分享到: