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

[kent4]

Счета за телефон присылают вот в таком файле, сумма только итоговая, а надо посчитать по каждому телефону отдельно.
т.е. чтобы получилась табличка:
№тел сумма
№тел сумма
№тел сумма
№тел сумма
№тел сумма

кол-во номеров может меняться

заранее спасибо, сам возможно разобрался, но очень срочно надо...

[staniiislav]

а по какому столбцу ориентироваться (номер телефона) А или Н?

[kent4]

По столбцу А

[kent4]

Сообщение от staniiislav

а по какому столбцу ориентироваться (номер телефона) А или Н?

По столбцу А

[DiemonStar]

Объединяете данные в одну таблицу и делаете сводную таблицу по столбцу A

[kent4]

Сообщение от DiemonStar

Объединяете данные в одну таблицу и делаете сводную таблицу по столбцу A

Я понимаю, что для вас это очень просто, но для меня нет, я VBA не знаю. Буду очень признателен, если подскажете как это написать

[DiemonStar]

Знание VBA для этого не нужно совсем. Практически все правки косметические и делаются за 10 минут.

[staniiislav]

можно так попробовать:

Option Explicit

Sub поиск_уникальных_и_сумма()
    Dim avArr, avArr2, li As Long, i As Long, j As Long, S1 As Integer, S2 As Integer
    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
        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(i, 2) = 0
            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
End Sub

[kent4]

Сообщение от DiemonStar

Знание VBA для этого не нужно совсем. Практически все правки косметические и делаются за 10 минут.

Это вариант, но как я понял там необходимо будет растягивать номера телефонов вниз, а кол-во строк 6000 и номеров там порядочно, это займет у пользователя минут 20 так точно.

[kent4]

Сообщение от staniiislav

можно так попробовать:

Option Explicit

Sub поиск_уникальных_и_сумма()
    Dim avArr, avArr2, li As Long, i As Long, j As Long, S1 As Integer, S2 As Integer
    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
        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(i, 2) = 0
            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
End Sub

При попытке скачать почему то запрашивает логи и пароль, не могли бы вы скинуть на почту bobrenok333@yandex.ru