1222,2333,3444.....数字黑洞终结者..
Private Function NumSort(Nd As String, Optional mods As Boolean = True) As String
Dim STRA$, a$, i%, j%
For i = 1 To Len(Nd)
a = Mid(Nd, i, 1): k = False
For j = 1 To Len(STRA)
If a >= Mid(STRA, j, 1) Then k = True: Exit For
Next j
STRA = IIf(k, Mid(STRA, 1, j - 1) & a & Mid(STRA, j, Len(STRA)), STRA & a)
Next i
NumSort = IIf(mods, STRA, StrReverse(STRA))
End Function
Private Sub TEST()
Dim k%, STRA$, STRB$, b As Boolean
STRA = InputBox("请输入一个4位数的正整数", "初始化", "1222"): STRB = STRA
Do
STRA = CLng(NumSort(STRA)) - CLng(NumSort(STRA, False)): i = i + 1
If STRA = 6174 Or i = 7 Then b = True
DoEvents
Loop Until b = True
If b Then
MsgBox "数字[" & STRB & "]计算" & i & "次得到" & STRA
Else
MsgBox "数字[" & STRB & "]计算7次得到" & STRA
End If
End Sub
Private Function NumSort(Nd As String, Optional mods As Boolean = True) As String
Dim STRA$, a$, i%, j%
For i = 1 To Len(Nd)
a = Mid(Nd, i, 1): k = False
For j = 1 To Len(STRA)
If a >= Mid(STRA, j, 1) Then k = True: Exit For
Next j
STRA = IIf(k, Mid(STRA, 1, j - 1) & a & Mid(STRA, j, Len(STRA)), STRA & a)
Next i
NumSort = IIf(mods, STRA, StrReverse(STRA))
End Function
Private Sub TEST()
Dim k%, STRA$, STRB$, b As Boolean
STRA = InputBox("请输入一个4位数的正整数", "初始化", "1222"): STRB = STRA
Do
STRA = CLng(NumSort(STRA)) - CLng(NumSort(STRA, False)): i = i + 1
If STRA = 6174 Or i = 7 Then b = True
DoEvents
Loop Until b = True
If b Then
MsgBox "数字[" & STRB & "]计算" & i & "次得到" & STRA
Else
MsgBox "数字[" & STRB & "]计算7次得到" & STRA
End If
End Sub