Question

如何在PowerPoint中找到并删除句子中重复的单词？

作为语法检查，我想找到错误输入的双字。例如：

Stackoverflow是一个 greate网站

在此示例中，将删除一个“a”。

Answer 1

我的朋友，如果你想重新发明自动语法检查，你正在开始一项危险的任务。自然语言充满了例外，保证可以逃避您认为可以完成工作的任何小规则。

无论如何，下面是一个清醒天真的刺。现在，此代码适用于您提供的示例。它将删除额外的“a”。但请注意，如果你关心保留语法，语法和语义，不应该删除每个重复的单词。自动删除重复的“那个”将会产生奇迹：

我喜欢那个网站。

但它会通过将语法降低到非正式的水平来改变作者的意图：

她说这是一个很棒的网站。

并删除重复将彻底破坏这里的一切：

That that is is that that is not is not that that is that that is is not true is not true.

更不用提了这个：

Buffalo buffalo Buffalo buffalo buffalo buffalo Buffalo buffalo.

为灾难做好准备！但无论如何，代码适用于您的示例（以及更多），并提供了一个框架供您构建和微调，使其适用于与您相关的大多数情况。

Dim shp As Shape
Dim str As String
Dim wordArr() As String
Dim words As Collection
Dim iWord As Long
Dim thisWord As String
Dim nextWord As String
Dim newText As String

For Each shp In ActivePresentation.Slides(1).Shapes
    If shp.HasTextFrame Then
        'Get the text
        str = shp.TextFrame.TextRange.Text
        'Split it into an array of words
        wordArr = Split(str, " ")

        'Transfer to a Collection, easier to deal with than array.
        Set words = New Collection
        For iWord = LBound(wordArr) To UBound(wordArr)
            words.Add wordArr(iWord)
        Next iWord

        'Look for repeats.
        For iWord = words.Count - 1 To 1 Step -1
            thisWord = words.Item(iWord)
            nextWord = words.Item(iWord + 1)

            'Make sure commas don't get in the way of a comparison
            'e.g. "This is a great, great site" is fine
            'but "This site is great great, and I love it" is not.
            nextWord = Replace(nextWord, ",", "")
            'Add whatever other filtering you feel is appropriate.
            'e.g. period, case sensitivity, etc.

            If LCase(thisWord) = LCase(nextWord) Then
                If LCase(thisWord) = "that" Then
                    'Do nothing. "He said that that was great." is ok.
                    'This is just an example. "had" is another.
                    'Add more filtering here.
                Else
                    words.Remove iWord + 1
                End If
            End If
        Next iWord

        'Assemble the text with repeats removed.
        newText = ""
        For iWord = 1 To words.Count
            newText = newText & words.Item(iWord) & " "
        Next iWord

        'Finally, put it back on the slide.
        shp.TextFrame.TextRange.Text = newText
    End If
Next shp

Answer 2

这是一个经典的RegExp应用程序，它可以使用反向引用删除单个镜头中的所有重复单词（而不是逐字循环）。

请注意，如果您需要有关访问基础PPT文本的详细帮助，那么您需要提供有关文本在幻灯片中的位置的更多信息

Sub TestString()
    MsgBox ReducedText("stackoverflow stackoverflow Stackoverflow is a a great site")
End Sub

Function ReducedText(strIn As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .IgnoreCase = True
        .Global = True
        .Pattern = "\b(\w+)\b(\s+\1\b)+"
        ReducedText = .Replace(strIn, "$1")
    End With
End Function

Answer 3

正则表达式使这很简单

Function remove_duplicates()

    txt = "Stackoverflow is a a greate site"

    Set word_match = CreateObject("vbscript.regexp")
    word_match.IgnoreCase = True
    word_match.Global = True

    For Each wrd In Split(txt, " ")
        word_match.Pattern = wrd & " " & wrd
        txt = word_match.Replace(txt, wrd)
    Next

    MsgBox txt

End Function

如何使用VBA在PowerPoint中查找和删除重复的单词？

3 个答案: