3

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

これが私が取っているすべてのアクションを含む完全版です（ほとんどはフォーマットですが、スペルチェックを行うという比較的高価なアクションが1つあり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

ある範囲のセルに2D配列を発射する非常に高速な方法があることは知っていますが、辞書に似たものがあるかどうかはわかりません。

*編集*

これまでのところ、セルに直接値を追加するのではなく、配列に値を追加してから、配列を起動して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

辞書を配列に変換してから、配列をワークシートに転送してみてください。すべてがメモリ内にあるため、変換は比較的高速である必要があります。

そうすれば、ループ内ではなく、1回のアクションで配列をワークシートに書き込むことができるはずです。

于 2013-03-26T14:59:35.223 に答える