Гистограмма распределений серий

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim f As Integer
Dim stext As String * 100
Dim Dict, st, s, s1, s2 As String
Dim i, j, k, n, q, x As Integer
Dim kol, arr(), tmp As String, ser, v(), max As Integer
Dim dlina() As Long
Private Sub Command1_Click()
f = FreeFile
Open "C:\TEST.txt" For Binary As f
Get (f), , stext
Close f
Text1.Text = stext
End Sub
 
Private Sub Command2_Click()
End
End Sub
 
Private Sub Command3_Click()
'load on excell
End Sub
 
Private Sub Command4_Click()
Set Dict = CreateObject("Scripting.Dictionary")
     st = stext
         For i = 0 To Len(st)
         s = ""
         Do
k = k + 1
s1 = Mid$(st, k, 1)
s2 = Mid$(st, k + 1, 1)
s = s & s1
 
         Loop Until s1 <> s2 Or s2 = ""
         If Not Dict.Exists(s) And s <> "" Then
             ReDim Preserve arr(n), v(n)
             Dict.Add s, n: arr(n) = s: v(n) = 1: n = n + 1
         Else
              v(Dict.Item(s)) = v(Dict.Item(s)) + 1
         End If
         If k >= Len(st) Then Exit For
     Next i
     
     For i = 0 To UBound(arr)
     For j = 0 To UBound(arr) - 1
     If Len(arr(j)) > Len(arr(j + 1)) Then
     kol = arr(j): arr(j) = arr(j + 1): arr(j + 1) = kol
     ser = v(j): v(j) = v(j + 1): v(j + 1) = ser
     End If
    Next j
    Next i
         
     max = v(0)
     For i = 0 To UBound(v) - 1
    If max < v(i) Then max = v(i)
    q = Len(arr(i))
    
     Text2.Text = Text2.Text & vbCrLf & arr(i) 'серия  
     Text3.Text = Text3.Text & vbCrLf & v(i) 'длина серии
     Text4.Text = Text4.Text & vbCrLf & q 'кол-во повторений
     Next i