Поиск совпадений и вывод на новую страницу

[IgorGO]

см.вложение.
см.лист1, аналогично с обьемом, можно стоимости для всех сосчитать

[Hugo121]

Тут недавно была похожая задача - слегка переделал под эту задачу тот свой код (осталась например переменная gottabl, которая здесь в общем не нужна, но не мешает)
Может быть это и не нужно, но я решил отдельно считать все виды звонков (4 существующих в данных вида, только объём, т.к. стоимость везде 0).
Код проверял на файле Игоря Книга626.
Запускать на активном Листе2, результат на Листе1 в O:R соответственно номерам в A.

Option Explicit
'переделано из http://www.programmersforum.ru/showpost.php?p=758764&postcount=34

Sub Otbor()
    Dim a(), b, c, d, e, i As Long, ii As Long, j As Long, jj As Long, k As Long, temp As String
    Dim gottabl As Workbook
    Set gottabl = ThisWorkbook 'Workbooks("2_готовая табл.xlsx")

    a = Range("C2:F" & Range("E" & Rows.Count).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 3)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = a(i, 1) & a(i, 3)
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = a(i, 3)
                b(j, 2) = a(i, 1)
                b(j, 3) = a(i, 4)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 4)
            End If
        Next
    End With


    With CreateObject("Scripting.Dictionary")

        For i = 1 To j
            temp = b(i, 1)
            If Not .Exists(temp) Then jj = jj + 1: .Item(temp) = jj
        Next

        ReDim c(1 To .Count, 1 To 5)

        For i = 1 To UBound(b)
            temp = b(i, 1)
            If Len(temp) Then
                c(.Item(temp), 1) = b(i, 1)
                Select Case b(i, 2)
                Case "Вх"
                    c(.Item(temp), 2) = b(i, 3)
                Case "Исх"
                    c(.Item(temp), 3) = b(i, 3)
                Case "ВхSMS"
                    c(.Item(temp), 4) = b(i, 3)
                Case "ИсхSMS"
                    c(.Item(temp), 5) = b(i, 3)
                End Select
            End If
        Next

    End With

With gottabl.Sheets(1)
    d = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value

ReDim e(1 To UBound(d), 1 To 4)

For i = 1 To UBound(d)
For ii = 1 To UBound(c)
If CStr(d(i, 1)) = CStr(c(ii, 1)) Then e(i, 1) = c(ii, 2): e(i, 2) = c(ii, 3): e(i, 3) = c(ii, 4): e(i, 4) = c(ii, 5): Exit For
Next ii, i
.Range("O1").Value = "Вх"
.Range("P1").Value = "Исх"
.Range("Q1").Value = "ВхSMS"
.Range("R1").Value = "ИсхSMS"
.Range("O2:R2").Resize(UBound(e)) = e
End With

End Sub

[Kinet]

Спасибо большое. Я пытался эту формулу применить, но у меня почему то не вышло. Все время 0 выдавало.

[Kinet]

Спасибо всем большое!!!