代码之家 › 专栏 › 技术社区 › John Bustos

vba-根据另一个非相邻列中的值对单个列进行排序

sorting excel-vba vba excel

John Bustos · 技术社区 · 7 年前

假设我在Excel(2016)工作表中有以下范围:

Sort Order:    Col1:    Col2:
3              A        A
4              B        B
2              C        C
1              D        D

和 我想保持所有其他列不变 ,但排序 Col2 基于 Sort Order 列。最终结果是:

Sort Order:    Col1:    Col2:
3              A        D
4              B        C
2              C        A
1              D        B

换句话说,我希望根据另一个非相邻列的值对特定列进行排序,而不影响我的范围内的任何其他列。

我知道我可以复制一个范围并粘贴回除要排序的列之外的所有内容中的原始值,但如果我可以不必这么做就离开的话,我就不太喜欢这个范围。否则,我可以想象我可以将范围作为数组导入,并从这一点实现我自己的排序过程(如果您有简单的代码来完成这项工作,请共享),但我希望有一种更简单的方法。

有什么想法吗?

4 回复 | 直到 7 年前

Xabier 7 年前

根据David Zemens的评论,您可以这样做:

Sub foo()
Dim ws As Worksheet: Set ws = Sheet1
'declare and set the Worksheet you are working with, amend as require
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A

Arr = ws.Range("B2:B" & LastRow) 'add values from column B into an Array

    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add2 Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange Range("A2:C" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'sort on column A
ws.Range("B2:B" & LastRow).Value = Arr 'add the values of the array back into Column B
End Sub

David Zemens 7 年前

这是另一种方式,只是为了好玩,使用 System.Collections.ArrayList 利用其内置的 Sort 方法。

应该是不言自明的,但如果不是,这里是…

我们缓存的原始值 colToSort 在里面 originalValues 数组,并使用“排序顺序”列定义数组列表,然后应用 排序 方法 sortList 对象。

仍然没有对工作表进行任何排序,但现在我们可以迭代 排序列表 和 Index 反对 原创性价值 写在纸上:

Option Explicit

Sub sortThis()
Dim sortList As Object
Dim i As Long
Dim sortOrder As Range
Dim colToSort As Range
Dim originalValues

Set sortList = CreateObject("System.Collections.ArrayList")
Set sortOrder = Range("A2:A5")
Set colToSort = Range("C2:C5")

originalValues = colToSort.Value
ReDim sortedValues(UBound(originalValues))

For i = 1 To sortOrder.Cells.Count
    sortList.Add (sortOrder.Cells(i).Value2)
Next

sortList.Sort

With Application
    For i = 0 To sortList.Count - 1
        sortedValues(i) = .Index(originalValues, .Match(sortList(i), sortOrder, False), 1)
    Next
    colToSort.Value = .Transpose(sortedValues)
End With
End Sub

Gary's Student 7 年前

使用列中的排序顺序 a和列中的数据 c ,in e2 enter:。

=index(c:c,match(rows($1:1),a:a,0)) 向下复制: 编辑1: 如果columna中的值不是简单的顺序整数,那么我们可以使用“helper column”。在F2中Enter:。 =min(a:a) 在f3中输入数组公式 =min(如果(A:A>F2,A:A,“”) 向下复制。array formulamust be entered withctrl.+shift.+enter.which not just theenter.key.如果正确执行此操作,公式将在公式栏中用大括号括起来。然后在e2中输入: =index(c:c,match(f2,a:a,0))。向下复制: 请注意,“helper”实际上只是列a的排序版本。向下复制: 编辑1: 如果列中的值一不是简单的序列整数,那么我们可以使用“helper列”。在地上二层输入: =MIN(A:A) 而在F3输入数组公式: =MIN(IF(A:A>F2,A:A,"")) 向下复制。数组公式必须输入Ctrl键+换档+进入而不仅仅是进入关键。如果操作正确,公式将在公式栏中以大括号括起来。然后在E2输入: =INDEX(C:C,MATCH(F2,A:A,0)) 向下复制: 请注意,“helper”实际上只是列的排序版本。一.

John Bustos 7 年前

虽然@davidzemens、@xabier和@garysstudent都提供了非常好的答案-都使用了vba和excel函数,但最终我自己编了一个:

仅复制(1)列作为排序依据( Sort Order )&(2)要排序的列( Col2 )进入一个新的空白区域。
根据第一列对该范围进行排序
将第二列复制回要排序的原始列

我使用该实现的原因是:

它允许在 排序顺序 柱
它允许我扩展到多个列/允许循环(我需要的)通过参数化它。

我的解决方案是:

Sub Tester()

' The data we want sorted and the column to sort by:
Dim SortByCol As Range
Dim ToSortCol As Range
    Set SortByCol = ThisWorkbook.Worksheets("Sheet1").Range("A1:A7")
    Set ToSortCol = ThisWorkbook.Worksheets("Sheet1").Range("C1:C7")


' An empty range to use for copying / pasting to:
Dim SortRange As Range
    Set SortRange = ThisWorkbook.Sheets("Sheet2").Range("A1")

    DoSort SortByCol, ToSortCol, SortRange
End Sub


Sub DoSort(SortByCol As Range, ToSortCol As Range, SortRange As Range)

    ' Copy our data to sort into a contiguous range so we can sort using Excel's native sort functionality:
    Union(SortByCol, ToSortCol).Copy SortRange

    ' Reset the SortRange to the entire pasted in region:
    Set SortRange = SortRange.CurrentRegion

    ' Sort the SortRange:
    With SortRange.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=SortRange.Range("A1:A" & SortRange.Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        .SetRange SortRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Copy the second column back into the ToSort Column:
    SortRange.Columns(2).Copy ToSortCol

    SortRange.Clear
End Sub

但是,我会说所提供的其他解决方案是完美的,但是我的具体情况最好使用上面的代码来处理。

再次感谢@davidzemes,@xabier和@garysstudent!!