Question

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

有人对这个问题有什么看法吗？

Answer 1

这是一个非常简单的小程序，用于对二维数组进行排序，例如范围：

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

如何使用此排序功能：

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

注意：

此处排序的范围位于Worksheet(1)的{{1}}上，输出将在同一张表格中Range("C3:D9")
范围将按升序排序。
范围将根据第一列（此处为C列）进行排序。如果您希望对其他列进行排序，则只需将所有Range("G3:H9")和aryToSort(i, 1)更改为要排序的列。例如，第2列：aryToSort(j, 1)和aryToSort(i, 2)。

UPDATE：

如果您希望将上述内容用作函数，那么这也可以这样：

aryToSort(j, 2)

这就是你如何使用这个功能：

Answer 2

这只是一个可以适应您需求的示例，它使用 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

原始单元格不已排序，它们仅被复制到排序的其他位置。

修改＃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 3

这里我提交了稍微不同的排序例程。它先排序第2列然后排在第1列。

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

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

排序范围而不在电子表格中对其进行排序

3 个答案:

UPDATE：