Сортировка двух несмежных столбцов без влияния на другие столбцы

Question

У меня есть две разные колонки в Excel. Я хочу создать сценарий, который будет сортировать столбец F (иметь заголовок) и сортировать столбец B в зависимости от того, где сработала сортировка столбца F. (Однако, не затрагивая другие столбцы!)

Так что если у меня есть

    ColB       ColF
 1. Cat        2
 2. Mouse      1
 3. Dog        3

Сортировка даст мне

    ColB       ColF
 1. Mouse        1
 2. Cat          2
 3. Dog          3

Как я могу это сделать? Я попытался записать макрос (или просто попытался отсортировать его, нажав две колонки и кнопку сортировки), но я получаю сообщение об ошибке: «Невозможно выполнить команду с несколькими вариантами выбора, щелкните один диапазон и повторите попытку»

Answer 1

Я подозреваю, что должен быть лучший способ выполнить все, что вы хотите сделать, путем сортировки этих столбцов, но вот решение VBA, которое будет делать именно то, что вы просили. Осторожно, этот код предполагает, что в диапазонах, которые вы хотите отсортировать, нет пустых ячеек. Пожалуйста, оставьте комментарий, если это проблема, потому что это будет довольно легко исправить.

Sub nonadjacentsort()
Dim rng1 As Range, rng2 As Range, rngTmp As Range, s1 As Worksheet, tmpS As Worksheet
Dim tmpArr1() As Variant, tmpArr2() As Variant
Dim i As Long
Set s1 = ActiveSheet
'Set Ranges to sort.  This assumes there are no blanks in your data.
Set rng1 = s1.Range("B1", Range("B1").End(xlDown))
Set rng2 = s1.Range("F1", Range("F1").End(xlDown))
'Load first column into temporary array
tmpArr1 = rng1.Value
'Load data into larger array that will hold both columns
ReDim tmpArr2(1 To UBound(tmpArr1, 1), 1 To 2) As Variant
For i = 1 To UBound(tmpArr1, 1)
    tmpArr2(i, 1) = tmpArr1(i, 1)
Next i
'Load second column into temporary array
Erase tmpArr1
tmpArr1 = rng2.Value
'Load second column into larger array
For i = 1 To UBound(tmpArr1, 1)
    tmpArr2(i, 2) = tmpArr1(i, 1)
Next i
Erase tmpArr1
'Add new sheet and print two columns there together.
Application.ScreenUpdating = False
Set tmpS = Sheets.Add
Set rngTmp = tmpS.Range("A1").Resize(UBound(tmpArr2, 1), 2)
rngTmp = tmpArr2
Erase tmpArr2
'Sort by second column (Column F of original data)
rngTmp.Sort rngTmp.Cells(1, 2), xlAscending, Header:=xlYes
'Load sorted data into array and then overwrite columns on original data
tmpArr1 = rngTmp.Columns(1).Value
rng1 = tmpArr1
Erase tmpArr1
tmpArr1 = rngTmp.Columns(2).Value
rng2 = tmpArr1
Erase tmpArr1
'Delete temporary sheet.
Application.DisplayAlerts = False
tmpS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub