怎么用最快的算法判断一个号码是否全部是同一个数字，或者只有2个

Question

譬如666666  就是只有一个数字
656665     只有2个数字
怎么判断这种？

Answer 1

Private Sub Command1_Click()
    Dim n As Long
    n = 6666
    If n / CLng(String(Len(CStr(n)), Left(CStr(n), 1))) = 1 Then
        MsgBox "是单一数字"
    Else
        MsgBox "不是单一数字"
    End If
End Sub

Answer 2

Option ExplicitPrivate Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)Private Sub Command1_Click()
    Dim s As String
    Dim a(0 To 9) As Long
    Dim b() As Integer
    Dim i As Long
    Dim j As Long
    
    s = "656656"
    
    If IsNumeric(s) = False Then Exit Sub
    
    ReDim b(0 To Len(s) - 1) As Integer
    CopyMemory b(0), ByVal StrPtr(s), LenB(s)
    
    ZeroMemory a(0), UBound(a)
    
    For i = 0 To UBound(b)
        b(i) = b(i) - 48
        a(b(i)) = a(b(i)) + 1
    Next
    
    j = UBound(a) + 1
    For i = 0 To UBound(a)
       If a(i) = 0 Then j = j - 1
    Next
    
    MsgBox j
End Sub

Answer 3

在一定条件下，happy_sea的算法是最快的。不过它只能判断是否是单一数字，不能求出当不是单一数字时，字符串含有多少个不同的数字；而且当数字大过最大的Long型数时或者等于0时，这个算法就没用了（溢出）。
Hassle的算法挺好的，计数算法吧。不过不明白ZeroMemory有什么用，似乎没了那句一样能用。
仿照Hassle的自己写了一个，效率比他的慢3倍以上。
Private Sub Command1_Click()
Dim i As Long
Dim j As Long
Dim a(0 To 9) As Long
Dim b() As Integer
Dim sngTime As Single
Dim sngTime1 As Single
sngTime = Timer
For j = 0 To 10000
  ReDim b(0 To Len(strShuZi) - 1) As Integer
  For i = 1 To UBound(b) + 1
      b(i - 1) = CInt(Mid(strShuZi, i, 1))
      a(b(i - 1)) = a(b(i - 1)) + 1
  Next
Next
j = UBound(a) + 1
For i = 0 To UBound(a)
   If a(i) = 0 Then j = j - 1
Next
sngTime1 = Timer
Text1 = Text1 & "VB我的:" & CStr(j) & "," & CStr(sngTime1 - sngTime) & vbCrLf
End Sub