Question

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

创建有理数的随机列表：

<!doctype html>
<html>
    <head>
        <meta charset="utf-8">
        <link rel="stylesheet" href="stylesheets/application.css">
        <script src="script1.js"></script>
        <script src="script2.js"></script>
        <script src="script3.js"></script>

    </head>

    <body>
      <label>Enter value : </label><input type="text" maxlength="512" id="reg_expr"/>
      <button type="button" onclick="yourFunction()">Click me</button>

    </body>
</html>

排序算法:(不工作）

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

我的插入排序代码无效 - 任何人都可以建议解决方案吗？

感谢您的帮助。

Answer 1

在VB.NET中有Richard Newcombe的插入排序很好的实现，可以很容易地在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

在VBA中插入排序 - 不起作用

1 个答案:

修改