繁体   English   中英

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

[英]VBA - Sort a single column based upon values in another, non-adjacent column

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

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

我想保留所有其他列不变 ,但根据“ Sort Order列中的值对Col2进行Sort Order 因此最终结果将是:

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

换句话说,我想基于另一个不相邻列的值对特定列进行排序,而不会影响我范围内的任何其他列。

我知道我可以复制范围并将其原始值粘贴到除要排序的列之外的所有内容中,但是如果我可以不必这样做而逃脱的话,我就不会那么喜欢。 否则,我想我可以将范围作为数组导入,并从那时开始实现我自己的排序过程(如果您有简单的代码可以执行此操作,请共享),但是我希望有一种更简单的方法。

有什么想法吗?

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

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

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

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

仍然没有对工作表上的任何内容进行排序,但是现在我们可以针对originalValues值迭代sortListIndex以写出工作表:

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

A列中的排序顺序和C列中的数据的情况下,在E2中输入:

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

并向下复制:

在此处输入图片说明

编辑#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))

并向下复制:

在此处输入图片说明

注意,“ helper”实际上只是A列的排序版本。

尽管@ 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 !!

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM