В тексте, находящемся в Word, выделить цветом и подсчитать слова, содержащие не менее двух повторяющихся букв - VBA

Узнай цену своей работы

Формулировка задачи:

В тексте, находящийся в word 2007, выделить цветом и подсчитать слова, содержащие не менее двух повторяющихся букв. Вот что у меня получилось:
Листинг программы
  1. Sub macros
  2. Dim oWrd As Range
  3. Dim parazit As String
  4. Dim i, j As Long
  5. parazit = ",.;:!?""'|/*+-=()[]{}_`~%^@" '???????-????????
  6. For Each oWrd In Selection.Paragraphs(1).Range.Words
  7. If (InStr(parazit, RTrim(oWrd)) = 0) And (oWrd <> Chr(13)) Then
  8. oWrd.Select
  9. With Selection
  10. If Right(.Range, 1) = Chr(32) Then
  11. .MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
  12. Set oWrd = .Range
  13. End If
  14. End With
  15. For i = 1 To (Len(RTrim(oWrd)) - 1)
  16. char = Mid(oWrd, i, 1)
  17. For j = 2 To Len(RTrim(oWrd))
  18. char2 = Mid(oWrd, j, 1)
  19. If char = char2 Then
  20. oWrd.HighlightColorIndex = wdBlue
  21. Exit For
  22. Exit For
  23. Else
  24. oWrd.HighlightColorIndex = wdRed
  25. End If
  26. Next j
  27. Next i
  28. End If
  29. Next oWrd
  30. End Sub
Однако текст выделяется не правильно. Кто может помочь? Как еще вывести в отдельной строке укрупненным шрифтом число выделенных слов.

Решение задачи: «В тексте, находящемся в Word, выделить цветом и подсчитать слова, содержащие не менее двух повторяющихся букв»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Sub bb()
  4. Dim oWord As Object, s$, i&, j&
  5. On Error GoTo err_col
  6. For Each oWord In ActiveDocument.Range.Words
  7.     With New Collection
  8.         s = Trim$(Replace$(oWord.Text, Chr$(160), "")) '<<< Sasha_Smirnov
  9.        For i = 1 To Len(s)
  10.             .Add 0, Mid$(s, i, 1)
  11.         Next
  12. next_word:
  13.     End With
  14. Next
  15. With ActiveDocument
  16.     .Range.InsertParagraphAfter
  17.     .Range.InsertAfter "Слов с повторяющимися буквами: " & j
  18.     With .Paragraphs(.Paragraphs.Count).Range.Font
  19.         .Size = .Size + 2
  20.     End With
  21. End With
  22. Exit Sub
  23.  
  24. err_col:        'v не цеплять пробел после слова v
  25. ActiveDocument.Range(oWord.Start, oWord.End + (Right$(oWord.Text, 1) = " ")) _
  26.     .HighlightColorIndex = wdBrightGreen
  27. j = j + 1
  28. Resume next_word
  29. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

6   голосов , оценка 4 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы