Question

我的电视剧本偶尔会有亵渎，必须引起第三方的注意。我构建了一个宏来搜索特定的单词，暂时取消它们以便它们不会再次被重复发现，并列出它们，以及它们在宏中发生的时间......问题：没有运行它，我知道它只会找到单词的第一个实例......有时他们会说同一个单词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

Answer 1

如果将内容放入Excel，可能会更容易。例如，假设每个时间代码和相关文本在Sheet1的A列中的单个CELL中，以下宏将在所有时间代码的列J中生成一个列表，其中出现指定的TARGET。可以扩展宏以查找其他目标，并将相关时间码的列表输出到不同的列中。

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

Answer 2

单词是否必须保留在文档中，还是可以复制/粘贴到新单词doc中？

Word宏找到亵渎，并创建一个事件列表

2 个答案: