sorting范围，而不用电子表格sorting

问题是关于在VBA中sorting数据。 假设我有一个Range("A1:A10") ，我想按升序sorting。 但是，我不希望对电子表格进行任何更改（因此所有计算均在VBA代码中进行）。 操作的输出应该是一个NewRange ，其中所有的数字都被sorting。

有人有关于这个问题的想法？

Answer 1

这只是一个可以适应您的需求的示例，它使用B11：B20作为NewRange ：

 Sub SortElseWhere() Dim A As Range, NewRange As Range Set A = Range("A1:A10") Set NewRange = Range("B11:B20") A.Copy NewRange NewRange.Sort Key1:=NewRange(1, 1), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub 

原始单元格没有sorting，它们只是复制到另一个sorting的位置。

编辑＃1：

在这个版本中， NewRange不是一个单元格范围，而是一个内部数组：

 Sub SortElseWhere2() Dim A As Range, NewRange(1 To 10) As Variant Dim i As Long, strng As String i = 1 Set A = Range("A1:A10") For Each aa In A NewRange(i) = aa i = i + 1 Next aa Call aSort(NewRange) strng = Join(NewRange, " ") MsgBox strng End Sub Public Sub aSort(ByRef InOut) Dim i As Long, J As Long, Low As Long Dim Hi As Long, Temp As Variant Low = LBound(InOut) Hi = UBound(InOut) J = (Hi - Low + 1) \ 2 Do While J > 0 For i = Low To Hi - J If InOut(i) > InOut(i + J) Then Temp = InOut(i) InOut(i) = InOut(i + J) InOut(i + J) = Temp End If Next i For i = Hi - J To Low Step -1 If InOut(i) > InOut(i + J) Then Temp = InOut(i) InOut(i) = InOut(i + J) InOut(i + J) = Temp End If Next i J = J \ 2 Loop End Sub 

Answer 2

这是一个非常简单的例程来sorting一个二维数组，如范围：

 Option Base 1 Option Explicit Function SortThisArray(aryToSort) Dim i As Long Dim j As Long Dim strTemp As String For i = LBound(aryToSort) To UBound(aryToSort) - 1 For j = i + 1 To UBound(aryToSort) If aryToSort(i, 1) > aryToSort(j, 1) Then strTemp = aryToSort(i, 1) aryToSort(i, 1) = aryToSort(j, 1) aryToSort(j, 1) = strTemp End If Next j Next i SortThisArray = aryToSort End Function 

如何使用这个sortingfunction：

 Sub tmpSO() Dim aryToSort As Variant aryToSort = Worksheets(1).Range("C3:D9").Value2 ' Input aryToSort = SortThisArray(aryToSort) ' sort it Worksheets(1).Range("G3:H9").Value2 = aryToSort ' Output End Sub 

笔记：

1. Range("C3:D9") Worksheet(1)中的Worksheet(1)上的sortingRange("C3:D9")和输出在同一工作表中的Range("G3:H9")
2. 范围将按升序sorting。
3. 范围将根据第一列（此处为列C）进行sorting。 如果你想sorting另一列，那么你只需要改变所有的aryToSort(i, 1)和aryToSort(j, 1)你想sorting的列。 例如，第2列： aryToSort(i, 2)和aryToSort(j, 2) 。

更新：

如果你喜欢使用上面的函数，那么这也可能是这样的：

 Option Base 1 Option Explicit Function SortThisArray(rngToSort As range) Dim i As Long Dim j As Long Dim strTemp As String Dim aryToSort As Variant aryToSort = rngToSort.Value2 For i = LBound(aryToSort) To UBound(aryToSort) - 1 For j = i + 1 To UBound(aryToSort) If aryToSort(i, 1) > aryToSort(j, 1) Then strTemp = aryToSort(i, 1) aryToSort(i, 1) = aryToSort(j, 1) aryToSort(j, 1) = strTemp End If Next j Next i SortThisArray = aryToSort End Function 

这就是你将如何使用该function：

Answer 3

在这里，我提交了稍微不同的sortingroutine.Itsorting第一列第一列第二列。

 Function BubbleSort(TempArray() As Variant, SortIndex As Long) Dim blnNoSwaps As Boolean Dim lngItem As Long Dim vntTemp(1 To 2) As Variant Dim lngCol As Long Do blnNoSwaps = True For lngItem = LBound(TempArray) To UBound(TempArray) - 1 If TempArray(lngItem, SortIndex) > TempArray(lngItem + 1, SortIndex) Then blnNoSwaps = False For lngCol = 1 To 2 vntTemp(lngCol) = TempArray(lngItem, lngCol) TempArray(lngItem, lngCol) = TempArray(lngItem + 1, lngCol) TempArray(lngItem + 1, lngCol) = vntTemp(lngCol) Next End If Next Loop While Not blnNoSwaps End Function Sub Test() Dim vntData() As Variant vntData = range("C3:D9") BubbleSort vntData, 2 BubbleSort vntData, 1 range("G3:H9") = vntData End Sub 

从这个程序获得的结果如下所示。