Vba Word宏来查找亵渎，并创建事件列表_Vba_List_Search_Ms Word

Vba Word宏来查找亵渎，并创建事件列表

vba list search ms-word

Vba Word宏来查找亵渎，并创建事件列表,vba,list,search,ms-word,Vba,List,Search,Ms Word,我有一些电视脚本，其中偶尔有亵渎的内容，必须提请第三方注意。我建立了一个宏来搜索特定的单词，暂时对它们进行变形，这样它们就不会再次被发现，并列出它们，以及它们在宏中出现的时间。。。问题：即使不运行它，我知道它只会找到单词的第一个实例。。。有时他们说同一个词20次。。。我需要列出每次事件和时间代码。不替换或突出显示。。只需列出单词。到目前为止我所拥有的。。。感谢您的帮助 Sub Macro7() ' ' Macro7 Macro ' ' Selection.Find.Cle

我有一些电视脚本，其中偶尔有亵渎的内容，必须提请第三方注意。我建立了一个宏来搜索特定的单词，暂时对它们进行变形，这样它们就不会再次被发现，并列出它们，以及它们在宏中出现的时间。。。问题：即使不运行它，我知道它只会找到单词的第一个实例。。。有时他们说同一个词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

如果将内容放入Excel，可能会更容易。例如，假设每个时间代码和相关文本都位于Sheet1上a列的单个单元格中，则以下宏将在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

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

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

由于没有人尝试过我的问题，我认为它的措辞不够清晰。它搜索内容的一个例子是：01:03:05:22诸如此类的亵渎和诸如此类的诸如此类。下一行01:09:44:22诸如此类的亵渎（我用了“狗”和“猫”）更多的诸如此类的从剧本中说的诸如此类的话没人能帮上忙？真的吗？既然没人试过我的问题，我想它的措辞还不够清楚。它搜索内容的一个例子是：01:03:05:22诸如此类的亵渎和诸如此类的诸如此类。下一行01:09:44:22诸如此类的亵渎（我用了“狗”和“猫”）更多的诸如此类的从剧本中说的诸如此类的话没人能帮上忙？真的吗？这个宏毫无意义。。。我在C1中放了一个亵渎的词，在C4、C7等中放了一个良性的词…在A1、A4、A7中放了定时码。。。将宏中的单词TARGET更改为匹配的亵渎，然后运行宏。。它只是抹去了C列中的所有内容…在J列中没有任何内容。。。我需要这个在WORD中运行…所以…谢谢你的尝试。但是第2行到第4行似乎与我的任务无关。@CJG为了使事情变得简单，我制作了宏，使整行（时间代码和相关文本）都放在A列的一个单元格中。假设每次代码/关联文本都由段落分隔，这就是它将如何从Word直接粘贴到Excel中的方式。我更新了答案以使其更清楚。在仔细检查宏时，我意识到find（）函数区分大小写。将其更改为search（），不区分大小写。此宏毫无意义。。。我在C1中放了一个亵渎的词，在C4、C7等中放了一个良性的词…在A1、A4、A7中放了定时码。。。将宏中的单词TARGET更改为匹配的亵渎，然后运行宏。。它只是抹去了C列中的所有内容…在J列中没有任何内容。。。我需要这个在WORD中运行…所以…谢谢你的尝试。但是第2行到第4行似乎与我的任务无关。@CJG为了使事情变得简单，我制作了宏，使整行（时间代码和相关文本）都放在A列的一个单元格中。假设每次代码/关联文本都由段落分隔，这就是它将如何从Word直接粘贴到Excel中的方式。我更新了答案以使其更清楚。在仔细检查宏时，我意识到find（）函数区分大小写。将其更改为search（），不区分大小写。