автоматизации для сортировки строк с объединенными ячейками

Question

Обычно при использовании первенствовать я не использовать объединенные ячейки как можно больше, но мы получили некоторые сгенерированные листы с программным обеспечением для управления иметь что-то вроде этого -_-

после поиска я обнаружил, что самый простой процесс - сортировка без слияния, затем слияние снова, но с header в таблицу и sheet number of sheets становится утомительным, известны слитые ячейки (I + J, M + N) и начало таблицы в строке 11, так что plage установлен, так есть ли макрос, который мог бы автоматизировать процесс?

EDIT:

я подправил код, который делает в Раздели их и затем слить часть , но нужно сделать это своим родом, и есть чистый код, чем это

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 here the 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