Зделайте у вьорде ету схему и збросьте или просто текст

Dim s, s1, s0, t As String        'строка, первая буква слова, слово, список нужных слов
s = InputBox("Введите строку:")
Do
    Do
        n = n + 1
        If s1 = "" Then s1 = Mid(s, n, 1)            'запоминаем первую букву слова
        If Mid(s, n, 1) = s1 Then m = m + 1       'считаем, сколько раз она встретилась
        s0 = s0 & Mid(s, n, 1)                          'запоминаем слово
        If n > Len(s) Then Exit Do
    Loop While Mid(s, n, 1) <> " "
If m = 1 Then t = t & s0                                 'переносим слово в список
m = 0                       'сбрасываем промежуточные переменные в исходное состояние
s1 = ""
s0 = ""
Loop Until n > Len(s)
If t = "" Then t = "Искомых слов нет"
MsgBox (t)

Uses crt;
const max=15;
var  a : array[1..max] of integer; 
i,k0,k1,k3 : integer;  
k:boolean;
begin     
randomize;     
k0:=0;     
k1:=0;     
writeln('исходные:');
for i:=1 to max do 
begin   
a[i]:=random(2);   
write(a[i]:4);   
end;
for i:=1 to 15 do
begin   
if a[i]=0 then inc(k0) else inc(k1);   
if a[i]<>0 then k:=true; 
if k=false then inc(k3);
end;   
writeln;   
writeln('количество нулей = ',k0);   
writeln('количество единиц = ',k1);   
writeln('количество нулей до первой единицы = ',k3);   
End.