在 vba 中取消合并、排序和合并单元格

Question

我正在使用 excel-vba，我必须使用合并的单元格按升序对行进行排序，我知道合并的单元格无法排序，这就是为什么，这种解决方法是解决我的问题的唯一方法。我需要取消合并单元格，然后复制第一个单元格的值并将其粘贴到第二个单元格，之后，代码将使用 A 列和 C 列对列表进行排序。然后如果A和C列的值相等，就会变成合并单元格。

我希望有人可以帮助我完成这个项目。

还可以查看此图片以查看列表。

Sort

所以，我构建了一个代码来完成这个过程，但它不能。

    Sub Sort()
    On Error GoTo myErr
    Dim myRange As Range
    Dim lstrow As Long
    Dim i As Integer
    Dim cel As Range

    Set myRange = Sheet1.Range("A2:C7")
    lstrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

    With myRange

    .UnMerge
    For Each cel In myRange
            If IsEmpty(cel) Then
                For i = 2 To lstrow
                   ' cel(i).Value = 1
                   Sheet1.Range(i).Copy Sheet1.Range(cel).PasteSpecial
                   Sheet1.Range("C3").CurrentRegion.Sort _
                   key1:=Sheet1.Range("C3"), order1:=xlAscending, _
                   Header:=xlGuess

                        Next i
             End If

            Next cel




    End With

    myErr:
    MsgBox "Unble to sort!"
    End Sub

“在这个世界上，减轻他人负担的人是无用的。 ——查尔斯·狄更斯”

问候，

Answer 1

如果您要在取消合并之前找到lstRow，请使用 B 列 — 如果 A 列中的最后一行已合并，则最底部的单元格为空！或者，如果您愿意，可以在取消合并后找到lstRow。

通过循环遍历myRange，您既可以UnMerge 任何合并的单元格，也可以使用原始合并单元格的MergeArea.address 填充新未合并的单元格。在对列 A 和 C 进行排序后，您可以遍历这些列，将每一行与下面的行进行比较。只有当下面的行与上面的两列的行相同时才重新合并。

Option Explicit

Sub Sort()

Dim myRange As Range
Dim lstrow As Long
Dim l As Long
Dim rng As Range
Dim address As String
Dim contents As Variant
Dim ws As Worksheet

On Error GoTo myErr

Set ws = ThisWorkbook.Sheets("Sheet1")
Set myRange = ws.Range("A1:C7")

' Get lstrow from Column B, if Column A has merged cells
lstrow = ws.Cells(Rows.Count, 2).End(xlUp).Row

' Unmerge and populate
For Each rng In myRange
    If rng.MergeCells Then
        ' Get value from top left cell
        contents = rng.MergeArea.Cells(1).Value
        address = rng.MergeArea.address
        rng.UnMerge
        ws.Range(address).Value = contents
    End If
Next rng

' Sort
myRange.Sort key1:=ws.Range("A1:A" & lstrow), _
    order1:=xlAscending, Header:=xlYes, key2:=ws.Range("C1:C" & lstrow), _
    order2:=xlAscending, Header:=xlYes

' Turn off alerts
Application.DisplayAlerts = False

' Re-merge
With ws
    For l = 2 To lstrow
        If .Cells(l, 1).MergeArea.Cells(1).Value = .Cells(l + 1, 1).MergeArea.Cells(1).Value _
            And .Cells(l, 3).MergeArea.Cells(1).Value = .Cells(l + 1, 3).MergeArea.Cells(1).Value Then

            ' Merge column A
            Range(.Cells(l, 1).MergeArea, .Cells(l + 1, 1)).Merge

            ' Merge column C
            Range(.Cells(l, 3).MergeArea, .Cells(l + 1, 3)).Merge
        End If
    Next l
 End With

' Turn on alerts
Application.DisplayAlerts = True

Exit Sub

myErr:
    MsgBox "Unable to sort!"
End Sub