Заголовок двойного клика для сортировки с объединенными ячейками VBA

Question

У меня есть лист, где у меня есть заголовки для столбцов в строке 4. У меня был код, который при двойном щелчке по ячейке в строке 4 сортировал данные по этой ячейке.У меня сейчас проблема в том, что в столбце B ячейки объединены со строкой ниже.Так, например, строки 4 и 5 объединены, строки 6 и 7 и т. Д. Код, который у меня есть, больше не позволяет сортировать из-за этих объединенных ячеек.Кто-нибудь может помочь?

Вот код, который я использовал

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

lr = Cells(Rows.Count, "B").End(xlUp).row
lc = Cells(4, Columns.Count).End(xlToLeft).Column
If Target.row = 4 And Target.Column <= lc Then Range(Cells(4, "B"), Cells(lr, lc)).Sort Key1:=Cells(4, Target.Column), Header:=xlYes 'Order1:=xlDescending

End Sub

Как и просил изображение моего листа

Answer 1

try

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim lc As Integer
    lc = Cells(4, Columns.Count).End(xlToLeft).Column
    If Target.Row = 4 And Target.Column <= lc Then
        sortdescent Target.Column - 1, lc
    End If
End Sub

код модуля

Sub sortdescent(x As Integer, col As Integer)
    Dim vDB
    Dim strTemp()
    Dim r As Integer, c As Integer, i As Integer, j As Integer
    Dim m As Integer

    ReDim strTemp(1 To 2, 1 To col)
    vDB = Range("b5", Cells(Range("c" & Rows.Count).End(xlUp).Row, col))
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)


    For i = 1 To r Step 2
        For j = 1 To r Step 2
            'If vDB(j, x) > vDB(i, x) Then 'Ascent
            If vDB(j, x) < vDB(i, x) Then 'Descent

                For m = 1 To c
                    strTemp(1, m) = vDB(i, m)
                    strTemp(2, m) = vDB(i + 1, m)
                    vDB(i, m) = vDB(j, m)
                    vDB(i + 1, m) = vDB(j + 1, m)
                    vDB(j, m) = strTemp(1, m)
                    vDB(j + 1, m) = strTemp(2, m)
                Next
            End If
        Next j
    Next i
    Range("b5").Resize(r, c) = vDB
End Sub