Option Explicit
Dim timeBegin As Long, timeEnd As Long
Dim rowAnal_1 As Long, rowAnal_2 As Long
Dim iRow As Variant
Dim iSum As Double
Dim aData As Variant, iCell As Variant, analRange As Variant, accRange As Variant
Dim currAnal As String

Sub Oborot_8_debet()
  timeBegin = GetTickCount
  Sheets("Дебет 8").Select
  Set analRange = Range("I4:I171")
  Set aData = Range([A4], Range("F" & Rows.Count).End(xlUp)) 'Диапазон с данными
' Сортировка key1 = КодЕлВтр; key2 = Дебет
  aData.Sort Key1:=Range("D4"), Order1:=xlAscending, Key2:=Range("A4"), Order2:=xlAscending, Orientation:=xlTopToBottom
  currAnal = aData(1, 4)
  iSum = 0
  For Each iCell In aData.Range("D1:D" & aData.Rows.Count)
    If iCell.Text = currAnal Then
      iSum = iSum + iCell.Offset(0, -1).Value
    Else
      Set iRow = analRange.Find(What:=currAnal, LookIn:=xlValue, LookAt:=xlWhole)
      If Not iRow Is Nothing Then
        iRow.Offset(0, 1).Value = iSum
      End If
      currAnal = iCell.Text
      iSum = iCell.Offset(0, -1).Value
    End If
  Next iCell
  timeEnd = GetTickCount
  Sheets("Дополнительно").Cells(2, 1) = "Module2"
  Sheets("Дополнительно").Cells(2, 2) = "Oborot_8_debet"
  Sheets("Дополнительно").Cells(2, 3) = (timeEnd - timeBegin) / 1000
End Sub