2

我创建了一个用于文本分析的 VBA 代码，但在运行时遇到了问题。我刚刚在 Google 上找到了关于使用 excel 内置函数的建议，但它并没有提高运行时间。

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

简而言之，这是我现在解决问题的方法：

  • 在 30k 文本单元上循环

  • 循环关键字

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

我还尝试使用搜索内置功能：

  • 循环关键字

  • 在包含 30k 文本单元格的整个工作表上搜索关键字

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

运行时间没有显着变化。

您可以在下面找到我的第一种方法的代码：

'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

您对如何提高性能有任何提示吗？

非常感谢！

4

2 回答 2

1

使用数组，A1:A3 中要搜索的数据，C1:C3 中的关键字和 D1:D3 中的分数

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

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

于 2016-07-11T08:43:08.383 回答
0

我建议两个优化：

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

  2. 使用InStrwith 函数vbTextCompare查找关键字的实例。

这是示例代码 - 我留下了存根供您重新插入评分函数代码：

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
于 2016-07-11T09:39:46.963 回答