Сформировать в новом документе таблицу с повторяющимися в тексте предложениями

13.11.2012, 15:36. **Показов** 770. **Ответов** 1

Author24 — интернет-сервис помощи студентам

Задание:
Сформировать в новом документе таблицу с повторяющимися в тексте предложениями. Во втором столбце таблицы указать кол-во искомых предложений. Таблица с предложениями не должна содержать одинаковых строк.
Можете помочь пожалуйста дописать код.

@anvg · 21.11.2012, 04:45

Mixan51,
Что как то у вас там только обозначения, без смыслового кода. Вот, пример, выводящий в Immediate сведения по предложениям

Visual Basic

Public Sub PrintRepeated()
    Dim RepeatCol As New Collection
    Dim pDict As Object, i As Long
    Dim pSentence As Range, sKey
    Set pDict = CreateObject("Scripting.Dictionary")
    If ThisDocument.Sentences.Count > 0 Then
        For Each pSentence In ThisDocument.Sentences
            If Not pDict.Exists(pSentence.Text) Then
                pDict.Add pSentence.Text, 1
            Else
                i = pDict(pSentence.Text)
                pDict(pSentence.Text) = i + 1
                RepeatCol.Add pSentence
            End If
        Next pSentence
        
        For Each sKey In pDict.Keys
            Debug.Print "Предложение — «" & sKey & "»" & vbLf & "Встречается " & CStr(pDict(sKey))
        Next sKey
    End If
End Sub

Коллекцию RepeatCol можно использовать для удаления дублей, но только с конца коллекции к началу. С вводом в таблицу отчёта, думаю, разберётесь самостоятельно.

Добавлено через 11 секунд
Mixan51,
Что как то у вас там только обозначения, без смыслового кода. Вот, пример, выводящий в Immediate сведения по предложениям

Visual Basic

Public Sub PrintRepeated()
    Dim RepeatCol As New Collection
    Dim pDict As Object, i As Long
    Dim pSentence As Range, sKey
    Set pDict = CreateObject("Scripting.Dictionary")
    If ThisDocument.Sentences.Count > 0 Then
        For Each pSentence In ThisDocument.Sentences
            If Not pDict.Exists(pSentence.Text) Then
                pDict.Add pSentence.Text, 1
            Else
                i = pDict(pSentence.Text)
                pDict(pSentence.Text) = i + 1
                RepeatCol.Add pSentence
            End If
        Next pSentence
        
        For Each sKey In pDict.Keys
            Debug.Print "Предложение — «" & sKey & "»" & vbLf & "Встречается " & CStr(pDict(sKey))
        Next sKey
    End If
End Sub

Коллекцию RepeatCol можно использовать для удаления дублей, но только с конца коллекции к началу. С вводом в таблицу отчёта, думаю, разберётесь самостоятельно.

	21.11.2012, 04:45