使用VBA从excel中获取数据到office数组

我有一个Excel文件，其中存储在列中的一些文本和关键字。

我想使用Excel中的数据，使用vba在Word中进行一些高级search。 但是我收到一个错误，试图将excel单元格中的数据转换为vba单词中的数组。

我已经使用了转置excel函数，但它不处理超过255个字符，所以我无法获得超过255个字符的单元格的值。

如果有人能帮我一把，我会很感激。

Option Explicit Dim strArray Dim range As range Dim i As Long Dim numberOfUniqMatches As Integer Dim totalMatches As Integer Sub HighlightMatchesAndSummarize() totalMatches = 0 '************************************ GET DATA FROM EXCEL *************************************** Dim xlApp As Object Dim xlBook As Object Const strWorkBookName As String = "D:\keyword_source_3.xlsx" On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err Then Set xlApp = CreateObject("Excel.Application") End If On Error GoTo 0 Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkBookName) 'xlApp.Visible = True xlApp.Visible = False 'transpose excel cells in our arrays strArray = xlApp.Transpose(xlApp.ActiveSheet.range("A1:A20" & AlRow).Value) Set xlBook = Nothing xlApp.Quit Set xlApp = Nothing ' ' End of data extraction '/******************************** SEARCH LOOP START ********************************** For i = 1 To UBound(strArray) numberOfUniqMatches = 0 Set range = ActiveDocument.range With range.Find .Text = strArray(i) .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchFuzzy = False .MatchPhrase = True .MatchSoundsLike = False .MatchAllWordForms = False Do While .Execute(Forward:=True) = True numberOfUniqMatches = numberOfUniqMatches + 1 totalMatches = totalMatches + 1 range.HighlightColorIndex = wdYellow Loop End With Next ' ' End of search loop ' Display message if no matching word is found If totalMatches <= 0 Then MsgBox "Sorry! No matching keyword found." Else MsgBox "Search ended: " & totalMatches & " matching word(s)." End If End Sub 

Answer 1

改变这个：

 strArray = xlApp.Transpose(xlApp.ActiveSheet.range("A1:A20" & AlRow).Value) 

至：

 'remove the transpose (and fix the range...) strArray = xlApp.ActiveSheet.range("A1:A" & AlRow).Value 

然后在你的循环中：

 For i = 1 To UBound(strArray, 1) '<<<<<<< numberOfUniqMatches = 0 Set range = ActiveDocument.range With range.Find .Text = strArray(i, 1) '<<<<<<< .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchFuzzy = False .MatchPhrase = True .MatchSoundsLike = False .MatchAllWordForms = False Do While .Execute(Forward:=True) = True numberOfUniqMatches = numberOfUniqMatches + 1 totalMatches = totalMatches + 1 range.HighlightColorIndex = wdYellow Loop End With Next 

Answer 2

在你的代码中joinByte ，并用Long代替。 Ctrl+H是Replace的快捷方式。