VBA配列による重複のカウント

Question

VBAの配列について質問があります。
処理速度についてかなり差が出ていて、教えてください。

Dictionaryを利用して重複したデータのカウントを行っています。countifのような形です。
データの始まりは4行目からで重複しているデータはC列、L列にカウントした数字を入れています。約３万件のデータがあり、シートはほかに7枚あり、INDEX・MATCH関数を多く利用しています。ファイルサイズは約5MBあります。
VBAを実行した結果のイメージは以下の通りです。
C列 L列
A1　　　1
A1　　　2
A1　　　3
B1　　　1
B1　　　2
B2　　　1

コードについては以下のように記載しています。

Sub 連番カウント()
    Dim i As Long, STG As Long
    Dim key As String
    Dim dicT As Object
    Dim startDateTime As Date
    Dim endDateTime As Date
    Dim processTime As Date
    
    Dim ws1 As Worksheet
    
    '開始日時を取得
    startDateTime = Now
    
    Set ws1 = ThisWorkbook.Worksheets(4)
        
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
        
    With ws1
    
    'STGで開始する行を指定 例:4行目からならSTG=4とする'
    STG = 4
    
    Set dicT = CreateObject("Scripting.Dictionary")

    'Row.Count,Cの場合C行を対象とする'
    For i = STG To Cells(Rows.Count, "C").End(xlUp).Row
        key = Cells(i, "C").Value

        If dicT.Exists(key) = False Then
            dicT.Add key, 1
        Else
            dicT(key) = dicT(key) + 1
        End If
    '重複カウントを格納する列を指定。この場合L行'
        Cells(i, "L").Value = dicT(key)
    Next
    
    End With
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
        
    '終了日時を取得
    endDateTime = Now
    
    '処理時間を算出
    processTime = endDateTime - startDateTime
    
    MsgBox "処理が完了しました!" & vbCrLf & vbCrLf & _
            "開始日時：" & startDateTime & vbCrLf & _
            "終了日時：" & endDateTime & vbCrLf & _
            "処理時間：" & processTime & vbCrLf, _
            vbOKOnly + vbInformation, "計測結果"
    
End Sub

L列に既にデータが入っていた場合は10秒ほどで終わります。前のデータがあった場合は13分かかっており、この差がなぜでてきているのか不明な状況です。

お力貸していただけないでしょうか。

Comments

[hatena19]

「L列に既にデータが入っていた場合」と「前のデータがあった場合」の違いがなんなのかが具体的にわかるように説明を追加していただけませんか。

[TAKAYUKIM]

申し訳ございません。記載ミスです。

「前のデータがあった場合」ではなく、「以前のデータを削除しクリアした状態の場合」　となります。

Answer 1

提示されたコードからはそのような差がでる原因はわかりませんが、
とりあえず、現状のコードを配列を利用して高速化するコード例をあげておきます。

Sub 連番カウント()
    Dim i As Long, STG As Long
    Dim key As String
    Dim dicT As Object
    Dim startDateTime As Date
    Dim endDateTime As Date
    Dim processTime As Date
    
    Dim ws1 As Worksheet
    
    '開始日時を取得
    startDateTime = Now
    
    Set ws1 = ThisWorkbook.Worksheets(4)
        
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
        
    With ws1
    
        'STGで開始する行を指定 例:4行目からならSTG=4とする'
        STG = 4
    
        Set dicT = CreateObject("Scripting.Dictionary")
    
       '対象セル範囲を配列に格納
        Dim ary
        ary = .Range(.Cells(STG, "C"), .Cells(.Rows.Count, "C").End(xlUp)).Value

        For i = 1 To UBound(ary)
            key = ary(i, 1)
            dicT(key) = dicT(key) + 1
            ary(i, 1) = dicT(key)
        Next
        .Cells(STG, "L").Resize(UBound(ary)).Value = ary
    End With
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
        
    '終了日時を取得
    endDateTime = Now
    
    '処理時間を算出
    processTime = endDateTime - startDateTime
    
    MsgBox "処理が完了しました!" & vbCrLf & vbCrLf & _
           "開始日時：" & startDateTime & vbCrLf & _
           "終了日時：" & endDateTime & vbCrLf & _
           "処理時間：" & processTime & vbCrLf, _
           vbOKOnly + vbInformation, "計測結果"
    
End Sub

Comments

[TAKAYUKIM]

お返事が遅くなりました。
ありがとうございます。

こちらでお示しいただいたコードを実行してみました。L列に値が入らない状況です。
ご教示いただけないでしょうか。

[hatena19]

当方のサンプルでは問題なく入ってます。
まったく同じコードですか。