1

我是 VBA 编码的新手。我已经用 Javascript 和 C++ 进行了一些编码，所以我理解这些概念。不过，我对 VBA 的细节不太熟悉。此特定代码适用于 Excel 2007。排序功能是从其他地方作为伪代码复制的（文档不是我的）。我已将其重写为 VBA（未成功）。

此代码无法正常工作。代码突然完全中止（不仅仅是跳出循环或函数，而是在经过两次 While 循环后完全退出。

要重现该问题，请将此代码保存为 Excel 工作表的宏，在 B5 中键入数字 9853，在 B6 中键入“=Kaprekar(B5)”。本质上，运行 Kaprekar(9853)。

有人可以帮我弄清楚我在这里做错了什么吗？谢谢。

顺便说一句，我现在正在使用 While-Wend。我也尝试了 Do While-Loop，结果相同。

这是代码：

Function Sort(A)
    limit = UBound(A)
    For i = 1 To limit
        ' A[ i ] is added in the sorted sequence A[0, .. i-1]
        ' save A[i] to make a hole at index iHole
        Item = A(i)
        iHole = i
        ' keep moving the hole to next smaller index until A[iHole - 1] is <= item
        While ((iHole > 0) And (A(iHole - 1) > Item))
            ' move hole to next smaller index
            A(iHole) = A(iHole - 1)
            iHole = iHole - 1
        Wend
        ' put item in the hole
        A(iHole) = Item
    Next i
    Sort = A
End Function

Function Kaprekar%(Original%)

    Dim Ord(0 To 3) As Integer

    Ord(0) = Original \ 1000
    Ord(1) = (Original - (Ord(0) * 1000)) \ 100
    Ord(2) = (Original - (Ord(1) * 100) - (Ord(0) * 1000)) \ 10
    Ord(3) = (Original - (Ord(2) * 10) - (Ord(1) * 100) - (Ord(0) * 1000))

    If (Ord(0) = Ord(1)) * (Ord(1) = Ord(2)) * (Ord(2) = Ord(3)) * (Ord(3) = Ord(0)) = 1 Then
        Kaprekar = -1
        Exit Function
    End If

    Arr = Sort(Ord)

    Kaprekar = Ord(3)
End Function
4

1 回答 1

4

excel 评估while语句中的两个项目，所以

While ((ihole > 0) And (A(ihole - 1) > item))

当 ihole=0 时，第一次测试返回 false，第二次测试越界，用#Value错误轰炸函数。

快速冒泡排序是这样的：

Option Explicit
Function Sort(A)
Dim iLoop As Long
Dim jLoop As Long
Dim Last As Long
Dim Temp

Last = UBound(A)

For iLoop = 0 To Last - 1
    For jLoop = iLoop + 1 To Last
        If A(iLoop) > A(jLoop) Then
            Temp = A(jLoop)
            A(jLoop) = A(iLoop)
            A(iLoop) = Temp
        End If
    Next jLoop
Next iLoop
Sort = A
End Function
于 2012-10-16T14:39:55.673 回答