对两个不相邻的列进行排序而不影响任何其他列

对两个不相邻的列进行排序而不影响任何其他列

我在 Excel 中有两个不同的列。我想创建一个脚本,对 F 列(有标题)进行排序,并根据 F 列的排序结果对 B 列进行排序。(但不影响任何其他列!)

所以如果我有

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

排序将给我

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

我该怎么做?我尝试录制一个宏(或者只是尝试通过单击两列和排序按钮对其进行排序),但我收到一条错误消息“该命令无法通过多项选择执行,请单击单个范围并重试”

答案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

相关内容