我正在开发一个自动同行评审宏,它会检查某些单词并在Microsoft Word文档中突出显示它们。但是,我希望将WordList = Split(" is , are ,", ",")
替换为我在excel中创建的列表。这对我来说更容易添加新单词,而不是手动输入我想在代码中突出显示的单词。
例如:A1有“是”这个词,所以我希望它会像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
答案 0 :(得分:0)
以下是从MS Word中的外部文件(Word,Excel和文本文件)中检索单词数组的三种方法。从文本文件中读取是最快的。
结果
---------- ----------
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
------------------------------
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
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