1

I am new to VBA coding. I have done some coding in Javascript and C++, so I do understand the concepts. I'm not too familiar with the specifics of VBA, though. This particular code is for Excel 2007. The sort function was copied from elsewhere as pseudocode (documentation is not mine). I've rewritten it as VBA (unsuccessfully).

This code is not working properly. The code is abruptly aborting entirely (not just jumping out of a loop or function, but quitting completely after going through the While loop twice.

To replicate the problem, save this code as a Macro for an Excel sheet, type the number 9853 in B5, and in B6 type "=Kaprekar(B5)". Essentially, run Kaprekar(9853).

Could someone please help me figure out what I'm doing wrong here? Thanks.

By the way, I'm using While-Wend now. I also tried Do While-Loop with the same result.

Here's the code:

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

whileExcel はステートメント内の両方の項目を評価するため、

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

ihole=0 の場合、最初のテストで false を返し、2 番目のテストで範囲外になり、#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 に答える