3

Scripting.Dictionary将a清空到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
4

1 回答 1

6

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

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

于 2013-03-26T14:59:35.223 回答