将 Scripting.Dictionary
清空到 Excel 工作表中的最快方法是什么?这就是我现在正在做的,但是对于一个包含大约 3000 个元素的字典来说,它的速度非常慢。我已经进行了所有我能想到的优化。
这是我所拥有的一个简单版本:
'wordCount and emailCount are late bound "Scripting.Dictionary" objects
Private Sub DictionaryToExcel(ByRef wordCount As Object, emailCount As Object)
oExcel.EnableEvents = False
oExcel.ScreenUpdating = False
Set oWorkbook = oExcel.Workbooks.Add
oExcel.Calculation = -4135
With oWorkbook.Sheets(1)
iRow = 1
For Each strKey In wordCount.Keys()
iWordCount = wordCount.Item(strKey)
iEmailCount = emailCount.Item(strKey)
If iWordCount > 2 And iEmailCount > 1 Then
.Cells(iRow, 1) = strKey
.Cells(iRow, 2) = iEmailCount
.Cells(iRow, 3) = iWordCount
iRow = iRow + 1
End If
Next strKey
End With
oExcel.ScreenUpdating = True
End Sub
这是完整版,包括我正在执行的每项操作(主要是格式化,但有一项相对昂贵的操作,即对 strKey
进行拼写检查(尽管我认为这已经优化到它可以是:
'wordCount and emailCount are late bound "Scripting.Dictionary" objects
Private Sub DictionaryToExcel(ByRef wordCount As Object, emailCount As Object)
Dim oExcel As Object, oWorkbook As Object
Dim strKey As Variant, iRow As Long
Dim iWordCount As Long, iEmailCount As Long, spellCheck As Boolean
Set oExcel = CreateObject("Excel.Application")
oExcel.EnableEvents = False
oExcel.ScreenUpdating = False
Set oWorkbook = oExcel.Workbooks.Add
oExcel.Calculation = -4135
With oWorkbook.Sheets(1)
iRow = 1
.Columns(1).NumberFormat = "@"
For Each strKey In wordCount.Keys()
iWordCount = wordCount.Item(strKey)
iEmailCount = emailCount.Item(strKey)
spellCheck = False
If iWordCount > 2 And iEmailCount > 1 Then
.Cells(iRow, 1) = strKey
.Cells(iRow, 2) = iEmailCount
.Cells(iRow, 3) = iWordCount
spellCheck = oExcel.CheckSpelling(strKey)
If Not spellCheck Then spellCheck = oExcel.CheckSpelling(StrConv(strKey, vbProperCase))
.Cells(iRow, 4) = IIf(spellCheck, "Yes", "No")
iRow = iRow + 1
End If
Next strKey
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Columns(4), Order:=1
.Sort.SortFields.Add Key:=.Columns(2), Order:=2
.Sort.SortFields.Add Key:=.Columns(3), Order:=2
.Sort.SetRange .Range(.Columns(1), .Columns(4))
.Sort.Apply
.Rows(1).Insert
.Rows(1).Font.Bold = True
.Cells(1, 1) = "Word"
.Cells(1, 2) = "Emails Containing"
.Cells(1, 3) = "Total Occurrences"
.Cells(1, 4) = "Is a common word?"
.Range(.Columns(1), .Columns(4)).AutoFit
If .Columns(1).ColumnWidth > 20 Then .Columns(1).ColumnWidth = 20
.Range(.Columns(2), .Columns(4)).HorizontalAlignment = -4152
End With
oExcel.Visible = True
oExcel.ScreenUpdating = True
End Sub
我知道有一种非常快速的方法可以将二维数组发射到一系列单元格中,但我不确定字典是否有类似的方法。
*编辑*
到目前为止,我已经通过将值添加到数组而不是直接添加到 excel 单元格,然后将数组触发到 excel 来做出改进:
Private Sub DictionaryToExcel(ByRef wordCount As Object, emailCount As Object)
Dim arrPaste() As Variant
Set oWorkbook = oExcel.Workbooks.Add
iRow = 1: total = wordCount.count
ReDim arrPaste(1 To total, 1 To 4)
For Each strKey In wordCount.Keys()
iWordCount = wordCount.Item(strKey)
iEmailCount = emailCount.Item(strKey)
spellCheck = False
If iWordCount > 2 And iEmailCount > 1 Then
arrPaste(iRow, 1) = strKey
arrPaste(iRow, 2) = iEmailCount
arrPaste(iRow, 3) = iWordCount
iRow = iRow + 1
End If
count = count + 1
Next strKey
With oWorkbook.Sheets(1)
.Range(.Cells(1, 1), .Cells(total, 4)) = arrPaste
最佳答案
尝试将字典转换为数组,然后将数组传输到工作表。转换应该相对较快,因为它都在内存中。
然后,您应该能够一次将数组写入工作表,而不是在循环中。
关于vba - 将字典清空到 Excel 工作表的最快方法,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/15639129/