在Excel VBA中使用查找来自列表中的Word

我正在一个自动同级审查macros，将检查某些单词，并在Microsoft Word文档中突出显示它们。 不过，我正在寻找用我在Excel中创build的列表replaceWordList = Split(" is , are ,", ",") 。 这对我来说更容易添加新的单词，而不是手动input我想在代码中突出显示的单词。

例如：A1有单词“is”，所以我希望它会像Wordlist = Split("A1, A2")

或类似Exlist = Range("A1:A2").value WordList = Split(ExList)

是这样的可能吗？ 感谢您的帮助。

  Sub PeerReview() Dim r As Range Dim WordList() As String Dim a As Long Dim Doc As Document Dim Response As Integer 'This code will search through all of the open word documents and ask you which ones you would like to peer review. For Each Doc In Documents 'MsgBox Doc Response = MsgBox(prompt:="Do you want to peer review " & Doc & "?", Buttons:=vbYesNo) If Response = vbNo Then GoTo ShortCut 'This code will highlight words that do not belong in the paragraph WordList = Split(" is , are ,", ",") 'List of words to check for when it is peer-reviewing Options.DefaultHighlightColorIndex = wdPink *'Highlight when found* For a = 0 To UBound(WordList()) Set r = ActiveDocument.Range With r.Find .Text = WordList(a) .Replacement.Highlight = wdYellow .Execute Replace:=wdReplaceAll End With Next 'next word ShortCut: Next End Sub 

Answer 1

这里有三种方法从MS Word中的外部文件（Word，Excel和文本文件）中检索单词的数组。 从文本文件中读取是最快的。

结果

• 词语：0.328125秒
• Excel：1.359130859375秒
• 文本：0.008056640625秒

---

 ---------- ---------- Get Word List from Word Document Start Time:12/1/2007 11:03:56 PM End Time:9/1/2016 12:53:16 AM Duration:0.328125 Seconds ------------------------------ ---------- ---------- Get Word List from Excel Start Time:12/1/2007 3:05:49 PM End Time:9/1/2016 12:53:17 AM Duration:1.359130859375 Seconds ------------------------------ ---------- ---------- Get Word List from Text Document Start Time:11/30/2007 6:16:01 AM End Time:9/1/2016 12:53:17 AM Duration:0.008056640625 Seconds ------------------------------ 

unit testing

 Sub TestWordList() Dim arData EventsTimer "Get Word List from Word Document" arData = GetWordsListDoc 'Debug.Print Join(arData, ",") EventsTimer "Get Word List from Word Document" EventsTimer "Get Word List from Excel" arData = GetWordsListXL 'Debug.Print Join(arData, ",") EventsTimer "Get Word List from Excel" EventsTimer "Get Word List from Text Document" arData = GetWordsListTxt 'Debug.Print Join(arData, ",") EventsTimer "Get Word List from Text Document" End Sub 

事件计时器

 Sub EventsTimer(Optional EventName As String) Static dict As Object If dict Is Nothing Then Set dict = CreateObject("Scripting.Dictionary") If dict.Exists(EventName) Then Debug.Print Debug.Print String(10, "-"), String(10, "-") Debug.Print EventName Debug.Print ; "Start Time:"; ; Now - dict(EventName) Debug.Print ; "End Time:"; ; Now Debug.Print ; "Duration:"; ; Timer - dict(EventName) & " Seconds" Debug.Print String(10, "-"); String(10, "-"); String(10, "-") dict.Remove EventName Else dict.Add EventName, CDbl(Timer) End If If dict.Count = 0 Then Set dict = Nothing End Sub 

从MS Word，Ms Excel和文本文件中检索单词列表的function。

 Function GetWordsListDoc() Const FilePath As String = "C:\Users\best buy\Downloads\stackoverfow\Wordlist\WordList.docx" Dim doc As Word.Document, oWords As Word.Words Dim x As Long Dim arData Set doc = Application.Documents.Open(FileName:=FilePath, ReadOnly:=True) Set oWords = doc.Words ReDim arData(oWords.Count - 1) For x = 1 To oWords.Count arData(x - 1) = Trim(oWords.Item(x)) Next doc.Close False GetWordsListDoc = arData End Function Function GetWordsListXL() Const FilePath As String = "C:\Users\best buy\Downloads\stackoverfow\Wordlist\WordsList.xlsb" Const xlUp = -4162 Dim arData Dim x As Long Dim oExcel As Object, oWorkbook As Object Set oExcel = CreateObject("Excel.Application") With oExcel .Visible = False Set oWorkbook = .Workbooks.Open(FileName:=FilePath, ReadOnly:=True) End With With oWorkbook.Worksheets(1) arData = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value arData = oExcel.WorksheetFunction.Transpose(arData) End With oWorkbook.Close False oExcel.Quit GetWordsListXL = arData End Function Function GetWordsListTxt() Const FilePath As String = "C:\Users\best buy\Downloads\stackoverfow\Wordlist\WordList.txt" Dim arData, f, fso Set fso = CreateObject("Scripting.Filesystemobject") Set f = fso.OpenTextFile(FilePath) arData = Split(f.ReadAll, vbNewLine) GetWordsListTxt = arData End Function