Fastests方法将字典清空到Excel工作表中

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 

尝试将字典转换为数组,然后将数组传送到工作表。 因为它全部在内存中,转换应该相对较快。

然后,你应该能够在一个动作中将数组写入工作表,而不是在循环中。