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

Question

將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單元格，然後燒製陣列擅長做了改進：

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 

Answer 1

嘗試將字典轉換爲數組，然後將數組傳送到工作表。轉換應該相對較快，因爲它全部在內存中。

然後，您應該能夠在一個動作中將數組寫入工作表，而不是在循環中。