Question

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

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

同时查看此图片以查看列表。

Sort

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

split

“在这个世界上，没有人能够减轻另一个人的负担。 -Charles Dickens“

此致

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

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

1 个答案: