Excel VBA SpellCheck的速度太慢

Question

我有一个电子表格，该电子表格将5列数据的所有排列列入文本的单列（X AKA 24），我的目标是将该列表中的实际单词仅提取到其自己的列中（Y aka aka 25）。第一部分不是使用VBA执行，并且几乎是瞬间发生的，但是咒语检查 +提取实际单词需要一个小时才能完成（我不得不在10分钟后停止它，甚至没有10％的方法） 。有更好的方法吗？

我的列表从第6行（n = 6）开始，范围（“ V3”）只是排列数（在这种情况下为83,521）。

Sub Permute_and_Extract()

n = 6

Range("X7:X1000000").ClearContents
Range("Y6:Y1000000").ClearContents

Max = Range("V3") + 5
Range("X6").Select
Selection.AutoFill Destination:=Range("X6:X" & Max)

For i = 6 To Max
x = Application.CheckSpelling(Cells(i, 24).Text)
If x = True Then
Cells(n, 25) = Cells(i, 24)
n = n + 1
End If
Next i


End Sub

Answer 1

从上面的评论中遵循：

Sub Permute_and_Extract()

    Const RNG As String = "F1:F10000"
    Dim wlist As Object, t, c As Range, i As Long, arr, res
    Dim rngTest As Range
    
    Set rngTest = ActiveSheet.Range(RNG)
    
    t = Timer
    Set wlist = WordsList("C:\Temp\words.txt", 5)
    Debug.Print "loaded list", Timer - t
    Debug.Print wlist.Count, "words"
    
    'using an array approach...
    t = Timer
    arr = rngTest.Value
    For i = 1 To UBound(arr, 1)
        res = wlist.exists(arr(i, 1))
    Next i
    Debug.Print "Array check", Timer - t
    
    'going cell-by-cell...
    t = Timer
    For Each c In rngTest.Cells
        res = wlist.exists(c.Value)
    Next c
    Debug.Print "Cell by cell", Timer - t
    
End Sub

'return a dictionary of words of length `wordLen` from file at `fPath`
Function WordsList(fPath As String, wordLen As Long) As Object
    Dim dict As Object, s As String
    Set dict = CreateObject("scripting.dictionary")
    dict.comparemode = vbTextCompare   'case-insensitive !!!
    With CreateObject("scripting.filesystemobject").opentextfile(fPath)
        Do While Not .AtEndOfStream
            s = .readline()
            If Len(s) = wordLen Then dict.Add s, True
        Loop
        .Close
    End With
    Set WordsList = dict
End Function

输出：

loaded list    0.359375 
 8938         words
Array check    0.019 
Cell by cell   0.030