我有一個電子表格，其中列出了 5 列資料的所有排列到單個文本列（列 X aka 24）中，我的目標是只從該串列中提取實際單詞到它自己的列中（列 Y aka 25）。第一部分不是用 VBA 執行的，幾乎是瞬間發生的，但是拼寫檢查 提取實際單詞需要一個多小時才能完成（我不得不在 10 分鐘后停止它，甚至不到 10% 的時間） . 有一個更好的方法嗎？
我的串列從第 6 行 (n = 6) 開始， Range("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
uj5u.com熱心網友回復：
根據上面的評論：
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qianduan/458960.html