Народ срочно помоги пожалуйста))

Тема в разделе "Visual Basic", создана пользователем drum21, 1 июн 2009.

  1. drum21

    drum21 Гость

    прога ищет количество натболее часто встречающихся первых букв в столбике из имен.
    нужно, шоб искала не только первые а все буквы в именах наиболее частую!

    Private Sub CommandButton1_Click()
    Dim k(8) As Integer, s As String, c As String, im As Integer
    i = 1: s = "": im = 1:
    Do While Cells(i, 1) <> "" 'делай пока есть слова
    c = Left(Cells(i, 1), 1) 'Выбираем первый символ нового имени
    j = InStr(1, s, c, vbTextCompare) 'Ищем его позицию в строке первых букв имен
    If j = 0 Then k(Len(s) + 1) = 1: s = s + c Else k(j) = k(j) + 1:
    i = i + 1 'проверка следующей буквы имени в столбце
    Loop 'конец цикла
    For j = 2 To Len(s)
    If k(j) > k(im) Then im = j 'Корректируем индекс самой часто встречающейся буквы
    Next j
    Cells(1, 2) = Mid(s, im, 1) + " = " + CStr(k(im)): 'выводим максимум
    End Sub

    пример


    даша к = 4
    даша
    саша
    клава
    света
    саша
    коля
    петя
    ксюша
    карина
    поля
    дюша

    прикреплю еще ексель там тож самое!
     

    Вложения:

    • __________.zip
      Размер файла:
      10 КБ
      Просмотров:
      13
  2. alex77755

    alex77755 Well-Known Member

    Регистрация:
    15 фев 2009
    Сообщения:
    128
    Симпатии:
    0
    если ещё актуально: Добавь цикл обработки букв в имени:

    [codebox]Sub Кнопка1_Щелкнуть()

    Dim k(28) As Integer, s As String, c As String, im As Integer
    Dim ii
    i = 1: s = "": im = 1:

    Do While Cells(i, 1) <> "" 'делай пока есть слова

    For ii = 1 To Len(Cells(i, 1)) 'делай пока есть буквы в слове

    c = Mid(Cells(i, 1), ii, 1) 'перебираем все символы в имени

    j = InStr(1, s, c, vbTextCompare) 'Ищем его позицию в строке первых букв имен

    If j = 0 Then k(Len(s) + 1) = 1: s = s + c Else k(j) = k(j) + 1:

    Next ii


    i = i + 1 'проверка следующего имени в столбце
    Loop 'конец цикла

    For j = 2 To Len(s)
    If k(j) > k(im) Then im = j 'Корректируем индекс самой часто встречающейся буквы
    Next j
    Cells(1, 2) = Mid(s, im, 1) + " = " + CStr(k(im)): 'выводим максимум

    End Sub[/codebox]
     
Загрузка...

Поделиться этой страницей