Arrays VBA中的插入排序-不工作

我有一个循环，它创建了一个有理数的随机列表，我正在尝试创建一个宏，它将使用插入排序算法组织数字降序

创建有理数的随机列表：

Sub SetUpList12()
    Dim UnsortedList(1 To 100, 1 To 1) As Double
    Dim L As Long
    For L = 1 To 100
        UnsortedList(L, 1) = Rnd(-L)
    Next L
    Range("A1:A10").Value = UnsortedList

End Sub

排序算法：（不工作）

Sub InsertSortTest2（）
Dim Num作为整数
作为整数的Dim C
作为整数的Dim D
作为整数的Dim Temp
作为整数的Dim p
p=Cells.CurrentRegion.Rows.Count
单元格（2，5）=p'仅用于检查'
ReDim Arr（p）为整数
我想我会坚持多久
变暗，变长
对于R=1到p
i=单元（R，1）
Num=p
对于C=0到Num-1
Arr（C）=i
下一个C
对于C=1到Num-1
D=C
而D>0和（Arr（D）

我的插入排序代码不起作用-有人能提出解决方案吗

---

谢谢你的帮助

在VB.NET中有一个很好的插入排序方式实现，它可以在16行Excel VBA中轻松地重新编码：

Sub InsertionSort(ByRef varData As Variant)

    Dim lngCounter1 As Long
    Dim lngCounter2 As Long
    Dim varTemp As Variant

    For lngCounter1 = 1 To UBound(varData)
        varTemp = varData(lngCounter1)
        For lngCounter2 = lngCounter1 To 1 Step -1
            If varData(lngCounter2 - 1) > varTemp Then
                varData(lngCounter2) = varData(lngCounter2 - 1)
            Else
                Exit For
            End If
        Next lngCounter2
        varData(lngCounter2) = varTemp
    Next lngCounter1

End Sub

它接受一个数组并进行插入排序。

Sub

接受数组

ByRef

，这意味着传递给函数的数组实际上得到排序，并且没有“before”和“after”数组

下面的测试代码显示它在

Double

和

String

中工作。在这些示例中，数组

varData

是一维数组，因此要使其在列中呈现，需要使用

Transpose

函数：

ws.Range("B1").Resize(UBound(varData), 1).Value = WorksheetFunction.Transpose(varData)

根据原始示例，只需使用

，1

，即可更新代码以使用二维数组

Option Explicit

Sub DoTests()

    Dim lngItemsToSort As Long
    Dim varData As Variant
    Dim lngCounter As Long
    Dim ws As Worksheet

    ''' double
    ' create 0-base array for test data
    lngItemsToSort = 9 ' 10-element array
    ReDim varData(0 To lngItemsToSort)

    ' get reference to a sheet and clear
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Cells.ClearContents

    ' create test data for Double
    VBA.Randomize
    For lngCounter = LBound(varData) To UBound(varData)
        varData(lngCounter) = VBA.Rnd
    Next lngCounter

    ' show test data
    ws.Range("A1").Resize(UBound(varData), 1).Value = WorksheetFunction.Transpose(varData)

    ' sort test data
    InsertionSort varData

    ' output sorted test data
    ws.Range("B1").Resize(UBound(varData), 1).Value = WorksheetFunction.Transpose(varData)

    MsgBox "Sorted Double values"

    ''' string
    ' create 0-base array for test data
    lngItemsToSort = 9 ' 10-element array
    ReDim varData(0 To lngItemsToSort)

    ' get reference to a sheet and clear
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Cells.ClearContents

    ' create test data for Double
    VBA.Randomize
    For lngCounter = LBound(varData) To UBound(varData)
        varData(lngCounter) = Chr(WorksheetFunction.RandBetween(65, 122))
    Next lngCounter

    ' show test data
    ws.Range("A1").Resize(UBound(varData), 1).Value = WorksheetFunction.Transpose(varData)

    ' sort test data
    InsertionSort varData

    ' output sorted test data
    ws.Range("B1").Resize(UBound(varData), 1).Value = WorksheetFunction.Transpose(varData)

    MsgBox "Sorted String values"

End Sub

Sub InsertionSort(ByRef varData As Variant)

    Dim lngCounter1 As Long
    Dim lngCounter2 As Long
    Dim varTemp As Variant

    For lngCounter1 = 1 To UBound(varData)
        varTemp = varData(lngCounter1)
        For lngCounter2 = lngCounter1 To 1 Step -1
            If varData(lngCounter2 - 1) > varTemp Then
                varData(lngCounter2) = varData(lngCounter2 - 1)
            Else
                Exit For
            End If
        Next lngCounter2
        varData(lngCounter2) = varTemp
    Next lngCounter1

End Sub

编辑 以下代码将用于OPs 2d阵列：

Option Explicit

Sub SetUpList12()
    Dim UnsortedList(0 To 99, 1 To 1) As Double
    Dim L As Long
    For L = 0 To 99
        UnsortedList(L, 1) = Rnd(-L)
    Next L
    Range("A1:A100").Value = UnsortedList

    'sort the list
    InsertionSort UnsortedList

    Range("B1:B100").Value = UnsortedList

End Sub

Sub InsertionSort2DArrayForRange(ByRef varData As Variant)

    Dim lngCounter1 As Long
    Dim lngCounter2 As Long
    Dim varTemp As Variant

    For lngCounter1 = 1 To UBound(varData, 1)
        varTemp = varData(lngCounter1, 1)
        For lngCounter2 = lngCounter1 To 1 Step -1
            If varData(lngCounter2 - 1, 1) > varTemp Then
                varData(lngCounter2, 1) = varData(lngCounter2 - 1, 1)
            Else
                Exit For
            End If
        Next lngCounter2
        varData(lngCounter2, 1) = varTemp
    Next lngCounter1

End Sub

---

你的问题是什么？？你的代码是否工作？是的，排序算法不工作。请阅读这里如何排序数组（气泡排序）我不能使用气泡排序。必须是插入排序。非常感谢您提供非常详细的答案。然而，这似乎不起作用。也许我没有正确地实现它，但我已经尝试了50多次以多种不同的方式将它集成到上面的代码中，但它拒绝工作。我添加了可以与数组一起工作的代码，但必须将第一维度更改为基于0的-例如，

Dim UnsortedList（0到99，1到1）作为Double

，而不是

Dim UnsortedList（1到100，1到1）作为双精度

@Robin Mackenzie，为什么需要1到1维？

Option Explicit

Sub SetUpList12()
    Dim UnsortedList(0 To 99, 1 To 1) As Double
    Dim L As Long
    For L = 0 To 99
        UnsortedList(L, 1) = Rnd(-L)
    Next L
    Range("A1:A100").Value = UnsortedList

    'sort the list
    InsertionSort UnsortedList

    Range("B1:B100").Value = UnsortedList

End Sub

Sub InsertionSort2DArrayForRange(ByRef varData As Variant)

    Dim lngCounter1 As Long
    Dim lngCounter2 As Long
    Dim varTemp As Variant

    For lngCounter1 = 1 To UBound(varData, 1)
        varTemp = varData(lngCounter1, 1)
        For lngCounter2 = lngCounter1 To 1 Step -1
            If varData(lngCounter2 - 1, 1) > varTemp Then
                varData(lngCounter2, 1) = varData(lngCounter2 - 1, 1)
            Else
                Exit For
            End If
        Next lngCounter2
        varData(lngCounter2, 1) = varTemp
    Next lngCounter1

End Sub