优化VBA文本search

我为文本分析创build了一个VBA代码，但在运行时遇到了一个问题。 我刚刚在Google上find了使用excel内置函数的build议，但是并没有改善运行时间。

这是我使用VBA的问题。 我有一个包含文本（平均一个或两个句子）的〜30k单元列表和一个1k关键字列表，所有这些关键字都有一个数字分数。 对于每个30k单元格，我想查看单元格包含哪些关键字，并计算find的关键字的总和。

这是我现在正在处理这个问题的方法：

• 在30k文本单元上循环

• 循环关键字

• 检查关键字是否在文本单元格中，如果是，则添加关键字的分数

我也尝试使用内置的function：

• 循环关键字

• 在包含30k文本单元的整个工作表中search关键字

• find关键字后，在相应的单元格上添加分数。

运行时间没有显着变化。

下面你可以find我的第一种方法的代码：

'Loop on all the 30k text cells For i = 2 To last_textcell 'loop on the number of different category of scores, setting intial scores to zero. For k = 1 To nb_score - 1 Score(k) = 0 Next k j = 2 'loop on the 1k keywords Do While j < last_keywords !search if the keyword is in the text cell If UCase(Sheets("DATA").Range("V" & i).Value) Like "*" & UCase(Sheets("Keywords").Range("A" & j).Value) & "*" Then 'if the keyword is found, add the score of the keyword to the previous score For l = 1 To nb_score - 1 Score(l) = Score(l) + Sheets("Keywords").Range("B" & j).Offset(0, l - 1).Value Next l End If j = j + 1 Loop 'paste the score For k = 1 To nb_categ - 1 Sheets("DATA").Range("CO" & i).Offset(0, k - 1).Value = Score(k) Next k Next i 

你有任何提示如何提高性能？

非常感谢你！

Answer 1

我build议两个优化：

1. 在运行testing之前，将句子列表和关键字加载到内存中。 这意味着您只需从表格中请求一次数据，而不是每次迭代testing。

2. 使用InStr函数与vbTextCompare查找关键字的一个实例。

这里是示例代码 – 我留下存根为您重新插入您的得分function代码：

 Option Explicit Sub QuickTest() Dim wsKeywords As Worksheet Dim wsData As Worksheet Dim lngLastRow As Long Dim varKeywords As Variant Dim varData As Variant Dim lngSentenceCounter As Long Dim lngKeywordCounter As Long Set wsKeywords = ThisWorkbook.Worksheets("Keywords") Set wsData = ThisWorkbook.Worksheets("DATA") 'get list of keywords in memory lngLastRow = wsKeywords.Cells(wsKeywords.Rows.Count, "B").End(xlUp).Row varKeywords = wsKeywords.Range("B2:B" & lngLastRow).Value 'get data in memory lngLastRow = wsData.Cells(wsData.Rows.Count, "V").End(xlUp).Row varData = wsData.Range("V2:V" & lngLastRow).Value 'your scoring setup code goes here '... 'iterate data For lngSentenceCounter = 1 To UBound(varData, 1) 'iterate keywords For lngKeywordCounter = 1 To UBound(varKeywords, 1) 'test If InStr(1, varData(lngSentenceCounter, 1), varKeywords(lngKeywordCounter, 1), vbTextCompare) > 0 Then 'you have a hit! 'do something with the score End If Next lngKeywordCounter Next lngSentenceCounter 'your scoring output code goes here '... End Sub 

Answer 2

使用一个数组，在A1：A3中search数据，在C1：C3中search关键字，在D1：D3中search得分

可以在列E中使用以下数组

=SUM(IFERROR(INDEX($D$1:$D$3,--(IF(NOT(ISERROR(SEARCH($C$1:$C$3,A1))),ROW($C$1:$C$3))),1),0))