Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.05.2019, 15:12   #1
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию изменение кода макроса - разобрать предложение на отдельные слова и подсчитать частоту использования каждого слова

Добрый день, задача состоит в следующем, предложение в ячейке А1 нужно скопировать в столбец под него, учитывая все знаки пунктуации, они копируются в отельную ячейку, точка признак конца предложения, она не должна копироваться в отдельную ячейку, вот мой код, который как то кусками собрал для того чтобы попытаться решить эту задачу, частично он справляется, но т.к. очень трудно дается понимание VBA прошу помощи
Код:
Sub xxx()
Dim A As String, i As Integer, k1 As Integer, k2 As Integer
 A = Trim(Range("A1"))
 If Right(A, 1) = "." Then A = Left(A, Len(A) - 1) & " ."
 A = A & " "
 
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 вне форума Ответить с цитированием
Старый 20.05.2019, 15:13   #2
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию

еще забыл добавить, что знаки пунктуации от слова пробелом не отделены, а следуют сразу за словом
Damlbdor вне форума Ответить с цитированием
Старый 20.05.2019, 15:24   #3
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию

из знаков пока что есть только ","
Damlbdor вне форума Ответить с цитированием
Старый 20.05.2019, 15:37   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

разбивать по пробелам проще функцией Split()

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

Может ли быть несколько предложений в одной ячейке?
Почему из знаков пунктуации только запятая? Другие будут?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.05.2019, 15:53   #5
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию

Есть предложение: " Как это сделать, как это сделать.". Нужно скопировать слова под этим предложением в столбец, каждое слово в отдельную ячейку, запятая тоже уходит в отдельную ячейку, использовать только циклы и условия, ну и строковые функции, слова разделены пробелом, либо запятой, "." признак конца предложения, она никуда не копируется, напротив скопированных значений, в соседнем столбце необходимо указать количество повторяющихся слов, а сами повторяющиеся слова копироваться не должны
Damlbdor вне форума Ответить с цитированием
Старый 20.05.2019, 15:59   #6
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию

Я понимаю что в код надо просто добавить условие, но не представляю как это перенести на программирование
Damlbdor вне форума Ответить с цитированием
Старый 20.05.2019, 16:14   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

для начала давайте возьмём такой код:
Код:
Private Function CountArray(Ar() As String, ToFind As String) As Long
Dim i&
    For i = LBound(Ar) To UBound(Ar)
        If Ar(i) = ToFind Then
            CountArray = CountArray + 1
        End If
    Next
End Function

Sub SplitMyWord()
Dim TextStr$, tDelim As Variant, i&, k&, lLastRow&
Dim AllWords() As String
 TextStr$ = Trim([A1])
 For Each tDelim In Array(",", " ", ".", ":", vbCr)
    TextStr = Replace(TextStr, tDelim, "°")
 Next tDelim

 AllWords = Split(TextStr, "°")
 
 lLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 If lLastRow > 1 Then: Range("A2:B" & lLastRow).Clear
 
 k = 1
 For i = LBound(AllWords) To UBound(AllWords)
    If Trim(AllWords(i)) <> "" Then
        k = k + 1
        Cells(k, "A") = AllWords(i)
        Cells(k, "B") = CountArray(AllWords, AllWords(i))
    End If
 Next i

End Sub
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.05.2019, 16:48   #8
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию

эта задача должна меня научиться пользоваться циклами и условиями, строковыми функциями, без массивов и функции которую вы используете в начале макроса, ваш макрос работает, но цель не достигнута
Damlbdor вне форума Ответить с цитированием
Старый 20.05.2019, 16:59   #9
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Damlbdor Посмотреть сообщение
и функции которую вы используете в начале макроса
ну, функцию легко убрать - просто перенеся тело функции внутрь цикла


Цитата:
Сообщение от Damlbdor Посмотреть сообщение
без массивов
а чем массивы не угодили?
с ними данная задача решается намного удобней.


Цитата:
Сообщение от Damlbdor Посмотреть сообщение
ваш макрос работает
запятые он не выводит. уж не знаю, нужно ли это Вам или нет.

Цитата:
Сообщение от Damlbdor Посмотреть сообщение
но цель не достигнута
конечно не достигнута. цель же состоит в том, чтобы Вы изучили материал и написали макрос
Извините, что пытался Вам помешать изучать материал курса!
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.05.2019, 17:06   #10
Damlbdor
Пользователь
 
Регистрация: 20.05.2019
Сообщений: 15
По умолчанию

ахах, спасибо, вы не помешали, и это не курс, на работе озадачили изучить vba, разбираюсь понемногу в маленьких задачках, что то пытаюсь, пока ничего толкового не выходит)
Damlbdor вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Дано предложение. Удалить из каждого слова повторяющиеся буквы staccy Помощь студентам 0 14.03.2017 20:32
Из текстового файла прочитать предложение, первую букву каждого слова сделать большой romaust C# (си шарп) 0 04.05.2016 10:51
в заданной строке символов (отдельные слова, разделенные пробелом) найти слова с совпадающими первой и последней буквами (С++) T_h_i_s Помощь студентам 0 19.11.2012 18:37
Вывести слова предложения в таком порядке, чтобы последняя буква каждого слова совпадала с первой буквой следующего слова ( java ) huhu Помощь студентам 0 06.04.2012 19:42
В заданном текстовом файле подсчитать частоту использования каждого слова из словаря (другого текстового lineico Помощь студентам 4 09.05.2011 19:35