使用合并单元格对行进行排序

Question

通常我会避免使用合并的单元格，但我们从管理软件中得到了这样的表格：

我发现最简单的过程是取消合并，排序，然后再次合并，但是header到表格，而sheet number of sheets变得单调乏味。已知融合的单元格（I + J，M + N），表格从第11行开始，因此页面已设置。

我调整了一个代码，该代码执行unmerge然后合并部分但需要对其进行排序，并且是否有比此更清晰的代码

Sub Merge_fused()
    '~~> unmerged range
    Dim MyRange As Range
    Set MyRange = Range("H11:X56")
    '~~> merged columns
    Dim IRange As Range
    Set IRange = Range("I11:J56")
    Dim MRange As Range
    Set MRange = Range("M11:N56")
    Dim VRange As Range
    Set VRange = Range("V11:W56")

    On Error Resume Next

    With MyRange
        .UnMerge
    End With

    '~~> i need to sort MyRange here

    With IRange
        .Merge True
    End With

    With MRange
        .Merge True
    End With

    With VRange
        .Merge True
    End With
End Sub

Answer 1

我会自动取消合并，然后扔掉弹出的空单元格。所以：之后没有重新合并。这样，您可以随时随意对数据进行排序。下面的代码就是这样（它还在数据表的末尾插入空白单元格，以防有任何内容跟在右边的表格中）。

' Unmerges the given column over the given rows
Sub UnmergeDataColumn( _
  theSheet As Worksheet, _
  firstCell As Range, lastCell As Range, _
  columnNrAfterTable As Long, _
  startMergedColumn As String, endMergedColumn As String _
)
  ' Unmerge the merged columns
  Dim mergedColumns As Range
  Set mergedColumns = theSheet.Range( _
    startMergedColumn & firstCell.Row, _
    endMergedColumn & lastCell.Row _
  )
  Call mergedColumns.UnMerge

  ' Throw away all unneeded cells
  Dim emptyColumn As Range
  Set emptyColumn = theSheet.Range( _
    endMergedColumn & firstCell.Row, _
    endMergedColumn & lastCell.Row _
  )
  Call emptyColumn.Delete(xlShiftToLeft)

  ' And insert extra padding after the table
  Dim trailingColumn As Range
  Set trailingColumn = theSheet.Range( _
    theSheet.Cells(firstCell.Row, columnNrAfterTable), _
    theSheet.Cells(lastCell.Row, columnNrAfterTable) _
  )
  Call trailingColumn.Insert(xlShiftToRight)
End Sub

Sub UnmergeData()
  ' Get the sheet
  Dim theSheet As Worksheet
  Set theSheet = Worksheets("Sheet1")

  ' Get the range of our table
  Dim firstCell As Range
  Set firstCell = theSheet.Range("K11")
  Dim lastCell As Range
  Set lastCell = theSheet.Range("X11").End(xlDown)
  Dim columnNrAfterTable As Long
  columnNrAfterTable = lastCell.Offset(0, 1).Column

  ' And unmerge the columns
  Call UnmergeDataColumn( _
    theSheet, _
    firstCell, lastCell, _
    columnNrAfterTable, _
    "V", "W" _
  )
  Call UnmergeDataColumn( _
    theSheet, _
    firstCell, lastCell, _
    columnNrAfterTable, _
    "M", "N" _
  )
  Call UnmergeDataColumn( _
    theSheet, _
    firstCell, lastCell, _
    columnNrAfterTable, _
    "I", "J" _
  )
End Sub

Answer 2

我知道这有点老了，但是我碰到了这个，使代码对我有用。 我将此代码添加到'~~> i need to sort here the MyRange here

projp.Range("your range").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo

对我来说很完美