Подсчет суммы

[staniiislav]

зачем Вам вообще скидывать? откройте свой документ, нажмите alt+f11, создайте модуль и скопируйте в него код

[staniiislav]

можно еще так:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub поиск_уникальных_и_сумма()
    Dim avArr, avArr2, li As Long, i As Long, j As Long, S1 As Integer, S2 As Integer, t
    
    With New Collection
        On Error Resume Next
        S1 = Application.InputBox(Prompt:="Поставьте начальную строку", Title:="НАЧАЛЬНАЯ СТРОКА", Type:=1)
            If S1 = 0 Then Exit Sub
        S2 = Application.InputBox(Prompt:="Поставьте конечную строку ", Title:="КОНЕЧНАЯ СТРОКА", Type:=1)
            If S2 = 0 Then Exit Sub
        t = GetTickCount
        avArr = Range("H" & S1 & ":" & "L" & S2).Value
        avArr2 = Range("H" & S1 & ":" & "L" & S2).Value
        For i = 1 To UBound(avArr)
            If IsEmpty(avArr(i, 1)) = False And avArr(i, 1) <> "Телефон Б" Then
                .Add avArr(i, 1), CStr(avArr(i, 1))
                If Err = 0 Then
                    li = li + 1: avArr(li, 1) = avArr(i, 1)
                Else: Err.Clear
                End If
            End If
        Next i

        For i = 1 To li
            avArr(li, 2) = 0
            avArr(li, 2) = Application.SumIf(Range("H" & S1 & ":" & "H" & S2), avArr(li, 1), Range("L" & S1 & ":" & "L" & S2))
            'For j = 1 To UBound(avArr)
            '     If avArr(i, 1) = avArr2(j, 1) Then
            '        avArr(i, 2) = avArr(i, 2) + avArr2(j, 5)
            '    End If
            'Next j
        Next i
        
    End With
    
    If li Then Range("O" & S1).Resize(li, 2).Value = avArr
    MsgBox (GetTickCount - t) / 1000
End Sub

[staniiislav]

не прав, сори, последний код работает не верно

добавлено позже:

нужно поменять вот этот кусок кода:

avArr(li, 2) = 0
            avArr(li, 2) = Application.SumIf(Range("H" & S1 & ":" & "H" & S2), avArr(li, 1), Range("L" & S1 & ":" & "L" & S2))
            'For j = 1 To UBound(avArr)
            '     If avArr(i, 1) = avArr2(j, 1) Then
            '        avArr(i, 2) = avArr(i, 2) + avArr2(j, 5)
            '    End If
            'Next j

на этот:

avArr(i, 2) = 0
            avArr(i, 2) = Application.SumIf(Range("H" & S1 & ":" & "H" & S2), avArr(i, 1), Range("L" & S1 & ":" & "L" & S2))
            'For j = 1 To UBound(avArr)
            '     If avArr(i, 1) = avArr2(j, 1) Then
            '        avArr(i, 2) = avArr(i, 2) + avArr2(j, 5)
            '    End If
            'Next j