Найти в файле цифру, повторяющуюся наибольшее количество раз

Sub QWERT()
Dim i, MAX, N
   Dim File As String, CF As String   'объявим пеpеменнyю для имени файла и его cодеpжимого
   File = ЭтаКнига.Path & "\8"   'ycтановим имя файла и пyть
   Open File For Binary As #1   'откpоем файл для чтения
      CF = Input(FileLen(File), 1)   'загpyзить в пеpеменyю CF вcе cодеpжимое файла
   Close #1   'закpыть файл
   For i = 0 To 9
   If MAX < UBound(Split(CF, i)) Then MAX = UBound(Split(CF, i)): N = i
   Next i
   MsgBox "число  " & N & " встретилось " & MAX & " раз", 64, ""
End Sub

Sub ReadFile(Name As String)
Dim nomFL As Integer, a, i
Dim S
Dim MAX, N
nomFL = FreeFile
Endln = Chr(10) + Chr(13)
Open Application.GetOpenFilename For Input As nomFL
Do Until EOF(nomFL)
Line Input #nomFL, S
For a = 0 To 9
   If MAX < UBound(Split(S, a)) Then MAX = UBound(Split(S, a)): N = a
   Next a
Label1.Caption = "Öèôðà " & N & " âñòðå÷àåòñÿ " & MAX & " ðàç" + Endln
Loop
Close #nomFL
End Sub

Sub ReadFile(Name As String)
Dim nomFL As Integer, a, i
Dim S
Dim MAX, N
nomFL = FreeFile
Endln = Chr(10) + Chr(13)
Open Application.GetOpenFilename For Input As nomFL
Do Until EOF(nomFL)
Line Input #nomFL, S
For a = 0 To 9
If MAX < UBound(Split(S, a)) Then MAX = UBound(Split(S, a)): N = a
Next a
Label1.Caption = "Öèôðà " & N & " âñòðå÷àåòñÿ " & MAX & " ðàç" + Endln
Loop
Close #nomFL
End Sub

Function FreqDig(fname as string) As integer
Dim D(0 to 10) As Long
      fi%=FreeFile
      Open fname For input as #fi%
      Do While(Not EOF(fi%))
          line input #fi%,Stri$
          For i%=1 to Len(Stri$)
              s$=mid$(Stri$,i%,1)
              n%=Asc(s$)
              if n% >= 48 And n% <= 57 then  D(n%-48)=D(n%-48)+1
          Next i%
       Loop
       mi%=0
       For i%=1 to 10
            If D(i%)>D(mi%) then mi%=i%
       Next i%
       FreqDig=mi%
End Function

          line input #fi%,Stri$
          For i%=1 to Len(Stri$)

Option Explicit
 
Sub tt()
    Dim a, Name$, el, max_&, n&, i&, ind&, t, col As New Collection
 
    With CreateObject("scripting.dictionary"): .comparemode = 1
        Name = ThisWorkbook.Path & "/8"
 
        a = Split(CreateObject("Scripting.FileSystemObject").Getfile(Name).OpenasTextStream(1).ReadAll, vbNewLine)
 
        For Each el In a
            ind = ind + 1: .RemoveAll
            max_ = 0: n = 0
            For i = 1 To Len(el)
                t = Mid(el, i, 1)
                If IsNumeric(t) Then
                    .Item(t) = .Item(t) + 1
                    If max_ < .Item(t) Then max_ = .Item(t): n = t
                End If
            Next
            col.Add _
            "В " & ind & "-ой строке максимальное количество повтор. - " & max_ & " - имеет цифра " & n
        Next
    End With
 
    '=======================================================
    If col.Count > 0 Then
        i = 0
        ReDim outarr(1 To col.Count + 1, 1 To 1)
 
        For Each el In col
            i = i + 1: outarr(i, 1) = el
        Next
 
        With Workbooks.Add(1)
            With .Sheets(1).[A1].Resize(i, 1)
                .Value = outarr
                .EntireColumn.AutoFit
            End With
        End With
    End If
    '=======================================================
 
End Sub

    '=======================================================
    If col.Count > 0 Then
        For Each el In col
        Me.TextBox1.Text = Me.TextBox1.Text & el & vbLf 'или vbNewLine
        Next
    End If
    '=======================================================