изменение кода макроса - разобрать предложение на отдельные слова и подсчитать частоту использования каждого слова

[SAS888]

Здравствуйте.

на работе озадачили изучить vba, разбираюсь понемногу в маленьких задачках

Если так, то зачем ограничиваться конкретным набором используемых функций?
Решение данной задачи только оговоренными Вами функциями будет очень не рациональное. Я бы сделал так:

Sub qq()
    Dim s As String, i As Long, q, z
    If [A1] = "" Then Exit Sub
    s = Replace(Replace(LCase([A1]), ",", " , "), ".", "")
    q = Split(Application.Trim(s))
    Set z = CreateObject("Scripting.Dictionary")
    For i = LBound(q) To UBound(q)
        If z.Exists(q(i)) Then z(q(i)) = z(q(i)) + 1 Else z(q(i)) = 1
    Next
    Range("A2:B" & Rows.Count).ClearContents
    [A2].Resize(z.Count).Value = Application.Transpose(z.Keys)
    [B2].Resize(z.Count).Value = Application.Transpose(z.Items)
End Sub

[Damlbdor]

Сообщение от SAS888

Решение данной задачи только оговоренными Вами функциями будет очень не рациональное.

Но нужно только ими.

[Serge_Bliznykov]

Сообщение от Damlbdor

Но нужно только ими.

вот, не пользы дела, а только из любопытства - а чем это ограничение вызвано?
Вот реально непонятно, зачем пытаться "забить гвоздь шуруповёртом"?

ну и тогда вопрос - а что не получается? какую помощь Вы ожидаете получить?

[Damlbdor]

в мой код поставить условие: если увидели запятую, ее копировать в отдельную строку, если увидели точку, она означает, что предложение закончено, но точка никуда не копируется и повторяющиеся слова чтоб не выносились в отдельные ячейки

[Serge_Bliznykov]

Сообщение от Damlbdor

в мой код поставить условие: если увидели запятую, ее копировать в отдельную строку, если увидели точку, она означает, что предложение закончено, но точка никуда не копируется и повторяющиеся слова чтоб не выносились в отдельные ячейки

продолжаем разговор... (c) Карлсон

1) обязательно поставьте опцию "Requare Variable Declaration"
см. меню "Tools" - "Options..." - закладка "Editor"

в начале модуля должно быть

Option Explicit

у Вас это не установлено. судя по тому, что переменная J из вашего кода не описана.




2) попробуйте такой код

Option Explicit

Sub xxx()
Dim A As String, j As Integer, i As Integer, k1 As Integer, k2 As Integer
 A = Trim(Range("A1"))
 k1 = InStr(1, A, ".")
 If k1 = 0 Then
    MsgBox "Нет точки в конце"
    Exit Sub
 End If
 A = Trim(Left(A, k1 - 1))
 If A = "" Then
    MsgBox "Пустой текст до первой точки. Нечего делать"
    Exit Sub
 End If
 
 A = Replace(A, ",", " , ") & " "

 Range("A2:B" & Rows.Count).ClearContents ' очистить старое

 k1 = 0
 i = 0
Do
    k2 = InStr(k1 + 1, A, " ")
     If k2 = 0 Then Exit Do
      If k2 - k1 > 1 Then
        i = i + 1
      Cells(1 + i, 1) = Mid(A, k1 + 1, k2 - k1 - 1)
    End If
    k1 = k2
Loop
k2 = i + 2
For i = 2 To k2 - 1
  If Cells(i, 2) <> -1 Then
    A = Cells(i, 1): k1 = 1
    For j = i + 1 To k2
      If A = Cells(j, 1) Then Cells(j, 2) = -1: k1 = k1 + 1
    Next
    Cells(i, 2) = k1
  End If
Next
For i = 2 To k2
  If Cells(i, 2) = -1 Then Cells(i, 2) = ""
Next
End Sub

[Damlbdor]

Sub xxx()
Dim A As String, j As Integer, i As Integer, k1 As Integer, k2 As Integer
 A = Trim(Range("A1")) ' убираем пробелы в начале и в конце строки
 k1 = InStr(1, A, ".") ' сравнение строк(положение символа в А с которого начинается проверка, содержится ли А в "."
 If k1 = 0 Then ' если k1=0 тоесть проверка посимвольно закончилась
Exit Sub 'выйти из процедуры
 End If ' закончить условие
 A = Trim(Left(A, k1 - 1))' переменной А присвоить значение, убрать пробелы вначале и в конце строки(возращает копию части строки А начиная с первого символа, количество символов до точки минус 1)
If A = "" Then  ' если А равно значению в кавычках тогда
Exit Sub ' выйти из процедуры
 End If ' закончить условие
 A = Replace(A, ",", " , ") & " " ' присвоить переменной А, вернуть исходную строку с замененным строковым фрагментом(строка А, подстрока которую нужно заменить ",", " , ") соединить с пробелом
 k1 = 0 ' присвоить переменной k1 значение 0
 i = 0 'присвоить переменной i значение 0
Do
    k2 = InStr(k1 + 1, A, " ")
    ' присвоить переменной k2 значение равное сравнение строк(положение символа к1+1, строка А, пробел)
     If k2 = 0 Then Exit Do
     ' если к2 присвоить значение 0 тогда выйти из цикла
      If k2 - k1 > 1 Then
      ' если к2-к1 больше 1 тогда
        i = i + 1
        ' i присвоть значение i+1
      Cells(1 + i, 1) = Mid(A, k1 + 1, k2 - k1 - 1)
      ' ячейке(строка 1 + i, столбец 1) присвоить значение извлеченное из (строки А, положение символа k1+1, количество копирумеых символов к2-к1-1)
    End If
    ' закончить условие
    k1 = k2
    ' присвоить к1 значение к2
Loop
' повтор цикла
k2 = i + 2
'присвоить к2 значение i+2
For i = 2 To k2 - 1 '
  If Cells(i, 2) <> -1 Then
  ' если ячейка(строка i, столбец 2) не равно -1 тогда
    A = Cells(i, 1): k1 = 1
    ' присвоить А значение ячейка( строка i, столбец 1) НЕ ЗНАЮ ЧТО ЗНАЧИТ ДВОЕТОЧИЕ присвоить к1 значение 1
    For j = i + 1 To k2
    ' счетчик цикла от i+1 до к2
      If A = Cells(j, 1) Then Cells(j, 2) = -1: k1 = k1 + 1
      ' если присвоить А значение равное ячейка(строка j, столбец 1) тогда ячейке(строка j, столбец 2) присвоить значение -1 НЕ ЗНАЮ ЧТО ЗНАЧИТ ДВОЕТОЧИЕ присвоить к1 значение к1+ 1
    Next ' повтор цикла
    Cells(i, 2) = k1 ' ячейке(строка i, столбец 2) присвоить значение к1
  End If ' закончить условие
Next ' повтор цикла
For i = 2 To k2 ' счетчик цикла рт 2 до к2
  If Cells(i, 2) = -1 Then Cells(i, 2) = ""
  ' если ячейка(строка i, столбец 2) присвоить значение -1 тогда ячейка(строка i, столбец 2) присвоить значение равное в кавычках
Next ' повтор цикла
End Sub 'выход из процедуры

Доброе утро, я все же правильно понимаю?

[Damlbdor]

И как в здравом уме все это из головы брать и писать такой код который будет выполнять то что мне нужно?

[Damlbdor]

я правда убрал то, что не нужно

[Аватар]

оффтоп

Сообщение от Damlbdor

И как в здравом уме все это из головы брать и писать такой код который будет выполнять то что мне нужно?

Программисты все психи раз берут все это из головы в здравом уме. А может и не в здравом ))

[Serge_Bliznykov]

Сообщение от Damlbdor

сравнение строк(положение символа в А с которого начинается проверка, содержится ли А в "."

поиск подстроки в строке - возвращается позиция первого вхождения подстроки или 0, если нет такой подстроки в строке

Сообщение от Damlbdor

If k1 = 0 Then ' если k1=0 тоесть проверка посимвольно закончилась

нет. k1=0 если в строке не найдена точка (см. сообщение пользователю ниже)

Сообщение от Damlbdor

A = Trim(Left(A, k1 - 1))

в переменную A поместить часть строки A до первой точки (обрезав ведущие и конечные пробелы)

Сообщение от Damlbdor

If A = "" Then  ' если А равно значению в кавычках тогда

если после обрезки осталась пустая строка (это значит, что до первой точки в строке либо пробелы, либо ничего вообще нет

Сообщение от Damlbdor

If k2 = 0 Then Exit Do
     ' если к2 присвоить значение 0 тогда выйти из цикла

нет тут никакого присваивания. знак "=" в условных операторах означает сравнение (читаем, ЕСЛИ K2 равно 0 ТОГДА <что то делать>...)
и вообще - это же строчка кода из вашего кода. Вы взяли чужой код и не понимаете, что там происходит? Тогда надо разобраться.

Сообщение от Damlbdor

A = Cells(i, 1): k1 = 1

' присвоить А значение ячейка( строка i, столбец 1) НЕ ЗНАЮ ЧТО ЗНАЧИТ ДВОЕТОЧИЕ присвоить к1 значение 1

двоеточие позволяет записать несколько команд в одну строчку
это полностью эквивалентно коду

A = Cells(i, 1)
k1 = 1

остальное более-менее.
При разборе кода старайтесь понимать не буквально, что означает каждая строчка,
а для чего она нужна.
для чего нужны переменные A k1 k2, что в них находится.
почему мы проверяем на ноль, что это означает,
что означает If k2 - k1 > 1 Then почему разница должна быть больше единицы
k1 = k2 ' присвоить к1 значение к2
что находится в k1 и k2 и для чего мы присваиваем k1 значение k2
и т.д.
для понимания нарисуйте блок-схему алгоритма (можно даже обобщённую)


Да. не забудьте ещё обязательно вставить команду очистки старого содержимого

Сообщение от Serge_Bliznykov

Range("A2:B" & Rows.Count).ClearContents ' очистить старое