VBAを使用してPowerPointで文章から繰り返し単語を見つけて削除するにはどうすればよいですか？

Question

PowerPointで繰り返し文章を検索して削除するにはどうすればよいですか？

文法チェックとして、間違って入力されたダブル単語を探したいと思います。たとえば：

StackOverflowのは、この例では greateのサイト

あり、一つは "" 削除されます。

Answer 1

私の友人は、自動文法チェックを再作成しようとすると危険な任務に着手しています。自然言語は、あなたが仕事をすると思われる何らかの小さなルールを回避するために保証された例外で満たされています。

とにかく、以下は、あまり知られていないナイーブスタブです。さて、このコードはあなたが与えた例で動作します。その余分な "a"が削除されます。しかし、文法や構文、セマンティクスを保つことを心がけているのであれば、すべての繰り返し単語を削除する必要はありません。繰り返された "自動的に削除する"は、これに不思議になります：

私はそのサイトが大好きです。

が、それは非常に非公式レベルまでの文法を取ることによって、この上の作家の意図を変更します：

を彼女はそれは素晴らしい場所であることを述べました。

と繰り返しを削除すると、ここでは絶対にすべてを台無しにする：

Buffalo buffalo Buffalo buffalo buffalo buffalo Buffalo buffalo.

：

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

がこれを言及しません

災害に備える！しかし、とにかく、コードはあなたの事例（そしてもっと）のために働き、あなたに関連した大部分のケースでうまくいくように微調整して構築するためのフレームワークを提供します。

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アプリケーションです

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 

Answer 3

簡単になります。あなたは基礎となる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