Как отсортировать значения с помощью VBA без изменения форматирования? - PullRequest
0 голосов
/ 31 января 2020

Код делает именно то, что должен, но я хотел бы знать, есть ли возможность сортировать только значения без изменения форматирования? На данный момент ячейки в диапазонах имеют 2 разных цвета. Так можно ли не допустить, чтобы он испортил цветовую схему?

Private Sub CommandButton2_Click()

    Range("A36:H160").UnMerge

    Range("A36:H160").Sort Key1:=Range("B36")

    Order1 = xlAscending
    Header = xlNo

    Range("E36:H160").Merge (True)


    Range("K36:R76").UnMerge

    Range("K36:R76").Sort Key1:=Range("L36")

    Order1 = xlAscending
    Header = xlNo

    Range("O36:R76").Merge (True)

End Sub

Workbook

1 Ответ

0 голосов
/ 02 февраля 2020

Вам нужно будет сохранить цвета и восстановить их после сортировки.

Кроме того, ваш код сортировки не совсем верен.

И поскольку вы повторяете этот процесс, я бы разделить код сортировки / цвета в частный саб

как-то так

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False

    DotheSort Range("A36:H160"), Range("B36"), Range("E36:H160")
    DotheSort Range("K36:R76"), Range("L36"), Range("O36:R76")

    Application.ScreenUpdating = True
End Sub


Private Sub DotheSort(rSrc As Range, rSortOn As Range, rMerge As Range)
    Dim colors As Variant
    Dim rw As Long, cl As Long

    ' save colors
    ReDim colors(1 To rSrc.Rows.Count, 1 To rSrc.Columns.Count)
    For cl = 1 To UBound(colors, 2)
        For rw = 1 To UBound(colors, 1)
            colors(rw, cl) = rSrc.Cells(rw, cl).Interior.Color
        Next
    Next

    rSrc.UnMerge
    rSrc.Sort Key1:=rSortOn, Order1:=xlAscending, Header:=xlNo
    rMerge.Merge True

    'Restore colors
    For cl = 1 To UBound(colors, 2)
        For rw = 1 To UBound(colors, 1)
            rSrc.Cells(rw, cl).Interior.Color = colors(rw, cl)
        Next
    Next
End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...