2

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

如果将内容放入 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
于 2012-05-17T20:27:12.743 回答