Rolling Countif

Question

У меня очень большой набор данных ~ 100000 строк с 2 столбцами, я хочу рассчитать скользящее количество на основе 2 критериев, в основном, сколько раз значение в столбце 1 по сравнению с столбцом 2.

Набор данных выглядит так

Я написал следующий код

Это частичный набор данных, фактический имеет 100000 строк, мне нужен ответ в столбце c

  Sub test()
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim id, data_week, ans,  a As Variant
   Dim p As Double

   a = 100000
   Debug.Print Now()


   id = Sheet1.Range("A2:A" & a).Value
   data_week = Sheet1.Range("B2:B" & a).Value
   ans = Sheet1.Range("c2:c" & a).Value

   For p = 1 To a

   ans(p, 1) = Application.WorksheetFunction.CountIfs(Sheet1.Range("A2:A" & p + 1), id(p, 1), 
   Sheet1.Range("b2:b" & p + 1), data_week(p, 1))

   Next p
   Sheet1.Range("c2:c" & a).Value = ans
   Debug.Print Now()
   Application.Calculation = xlCalculationAutomatic
  End Sub

В VBA это занимает ужасно много времени, интересно, есть ли более быстрый способ сделать это, например, оптимизировать код, благодарю за вашу помощь.

Answer 1

Попробуйте. Это займет 3 секунды.

Sub test3()
    Dim vDB, ans()
    Dim Ws As Worksheet
    Dim a As Long
    Dim i As Long, id, myDay
    Dim n As Integer

    Set Ws = Sheets(1)
    a = 100000
    Debug.Print Now()
    With Ws
        vDB = .Range("a2", .Range("b" & a))
        ReDim ans(1 To UBound(vDB, 1), 1 To 1)
        id = vDB(1, 1)
        myDay = vDB(1, 2)
        For i = 1 To UBound(vDB, 1)
            If vDB(i, 1) <> "" Then
                If id = vDB(i, 1) And myDay = vDB(i, 2) Then
                    n = n + 1
                    ans(i, 1) = n
                Else
                    id = vDB(i, 1)
                    myDay = vDB(i, 2)
                    n = 1
                    ans(i, 1) = n
                End If
            End If
            DoEvents
        Next
        .Range("c2").Resize(UBound(ans)) = ans
    End With

    Debug.Print Now()
End Sub