2

私は、第三者の注意を引く必要がある冒とく的な表現を時折含む TV スクリプトを持っています。特定の単語を検索し、一時的にそれらを変形して繰り返し検出されないようにし、それらをリストし、それらがマクロ内で出現する時間をリストするマクロを作成しました... 問題: 実行しなくても、単語の最初のインスタンスのみを見つけます...同じ単語を20回言うこともあります...各出現とタイムコードをリストする必要があります。置き換えたり強調表示したりせずに、単語をリストするだけです。私がこれまでに持っているもの...どんな助けも大歓迎です。

        Sub Macro7()
'
' Macro7 Macro
'
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "dog"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Copy

    ' places cursor inside the word so I can disfigure it

    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    ' xxx1 temporarily disfigures the word so it isn't re-found over and over

    Selection.TypeText Text:="xxx1"

    ' goes to end of document and pastes the word there,
    ' to be joined by the matching timecode to be found next

    Selection.EndKey Unit:=wdStory
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.Find.ClearFormatting
    ' returns to last instance of word and finds time code
    ' immediately preceeding it

    With Selection.Find
        .Text = "xxx1"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Find.ClearFormatting
    With Selection.Find

        'this is finding the time code

        .Text = "^?^?:^?^?:^?^?:^?^?"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    ' copies the time code value and goes to bottom of document
    ' to paste it with the word previously found

    Selection.Copy
    Selection.EndKey Unit:=wdStory
    Selection.TypeText Text:=vbTab
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeParagraph
    Selection.Find.ClearFormatting

    ' returns to the word just found

    With Selection.Find
        .Text = "xxx1"
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1


    ' begins the process for the next word "cat"

     Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "cat"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Copy

    ' places cursor inside the word so I can disfigure it
    ' etc etc etc

End Sub
4

2 に答える 2

0

単語はドキュメント内にとどまる必要がありますか、それとも新しい単語ドキュメントにコピー/貼り付けできますか？

于 2012-05-21T11:46:21.900 に答える
0

内容をエクセルに入れておいた方が楽かもしれません。たとえば、シート 1 の列 A の単一のセルに各タイム コードと関連するテキストがあると仮定すると、次のマクロは、指定された TARGET が表示されるすべてのタイム コードの列 J にリストを生成します。マクロを拡張して追加のターゲットを見つけ、関連するタイム コードのリストを別の列に出力することができます。

Sub FindTarget()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERROR(IF(SEARCH(""TARGET"",RC[-2]),""TRUE"",""FALSE"")),"""",IF(SEARCH(""TARGET"",RC[-2]),""TRUE"",""FALSE""))"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""true"",LEFT(RC[-3],8),"""")"
    Range("C1:D1").Select
    Selection.AutoFill Destination:=Range("C1:D9999"), Type:=xlFillDefault
    Columns("D:D").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("J1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("J1:J9999")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("C:D").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("K1").Select
End Sub
于 2012-05-17T20:27:12.743 に答える