![](/img/trans.png)
[英]Calculate the difference between two non-adjacent columns, based on a “match column” using Excel 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
值迭代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
在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函数,但最终还是自己编写了一个:
Sort Order
)和(2)要排序的列( Col2
)到新的空白范围。 我选择该实现的原因是:
Sort Order
列中使用任何类型的值 这是我的解决方案:
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.