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

时间:2018-07-18 12:54:22

标签: excel vba excel-vba sorting

假设我在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 个答案:

答案 0 :(得分:2)

根据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

答案 1 :(得分:2)

这是另一种有趣的方式,使用System.Collections.ArrayList来利用其内置的Sort方法。

应该是不言自明的,但是如果不是这样,那么...

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

在工作表上还没有进行任何排序,但是现在我们可以将sortListIndex相对于originalValues进行迭代以写到工作表:

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

答案 2 :(得分:1)

A 列中排序,将数据在 C 列中,在 E2 中输入:

=INDEX(C:C,MATCH(ROWS($1:1),A:A,0))

并向下复制:

enter image description here

EDIT#1:

如果 A 列中的值不是简单的连续整数,则可以使用“帮助列”。在 F2 中输入:

=MIN(A:A)

并在 F3 中输入数组公式

=MIN(IF(A:A>F2,A:A,""))

并向下复制。 数组公式必须使用 Ctrl + Shift + Enter 输入,而不仅仅是 Enter 键。如果正确完成此操作,则公式将显示在公式栏中,并带有大括号。

然后在 E2 中输入:

=INDEX(C:C,MATCH(F2,A:A,0))

并向下复制:

enter image description here

请注意,“帮助程序”实际上只是 A 列的排序版本。

答案 3 :(得分:0)

尽管@ DavidZemens,@ Xabier和@GarysStudent提供了非常好的答案-都使用VBA和Excel函数,但我最终还是自己做了:

  1. 仅将(1)列按({Sort Order)和(2)列进行排序(Col2)复制到新的空白范围。
  2. 根据第一列对该范围进行了排序
  3. 将第二列复制到我想排序的原始列上

之所以选择该实现,是因为:

  1. 它允许在Sort Order列中使用任何类型的值
  2. 它允许我将其扩展为多列/通过参数化允许循环(我需要)。

这是我的解决方法:

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 !!