Подсчет уникальных в дате

[DiemonStar]

можно еще со сводной попробовать

Вариант со сводной не катит - там учитываются повторы одного и того же счета.

Вот так можно с суммированием:

Sub Cnt()
Dim a(), i&
a = [A2].CurrentRegion.Value

Set Dates = CreateObject("scripting.dictionary")
Set Sums = CreateObject("scripting.dictionary")

With CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
      If Not .Exists(a(i, 1) & "|" & a(i, 2)) Then
        .Item(a(i, 1) & "|" & a(i, 2)) = 1
        Dates.Item(a(i, 2)) = Dates.Item(a(i, 2)) + 1
      Else
        .Item(a(i, 1) & "|" & a(i, 2)) = .Item(a(i, 1) & "|" & a(i, 2)) + 1
      End If
      Sums.Item(a(i, 2)) = Sums.Item(a(i, 2)) + a(i, 3)
    Next i
End With
If Dates.Count Then [F2].Resize(Dates.Count).Value = Application.WorksheetFunction.Transpose(Dates.Keys)
If Dates.Count Then [G2].Resize(Dates.Count).Value = Application.WorksheetFunction.Transpose(Dates.Items)
If Dates.Count Then [H2].Resize(Sums.Count).Value = Application.WorksheetFunction.Transpose(Sums.Items)
End Sub

[staniiislav]

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

staniiislav,
можно было из вашего же примера сделать намного проще:

Sub Cnt()
Dim a(), i&
a = [A2].CurrentRegion.Value

Set Dates = CreateObject("scripting.dictionary")

With CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
      If Not .Exists(a(i, 1) & "|" & a(i, 2)) Then
        .Item(a(i, 1) & "|" & a(i, 2)) = 1
        Dates.Item(a(i, 2)) = Dates.Item(a(i, 2)) + 1
      Else
        .Item(a(i, 1) & "|" & a(i, 2)) = .Item(a(i, 1) & "|" & a(i, 2)) + 1
      End If
    Next i
End With
If Dates.Count Then [F2].Resize(Dates.Count).Value = Application.WorksheetFunction.Transpose(Dates.Keys)
If Dates.Count Then [G2].Resize(Dates.Count).Value = Application.WorksheetFunction.Transpose(Dates.Items)
End Sub

не догадался )))) еще не полностью словари освоил (((

[Hugo121]

Думаю тут словарь в словаре нужен.
Собираем словарь дат, ему в итем словарь счетов, в нём каждому счёту в итем собираем суммы.
Выгрузка - в цикле перебираем первый словарь, в цикле вложенный. Можно в промежуточный массив.
Так получите даты/счета/суммы.
В каком виде это выгружать - пока непонятно.
Но писать сейчас некогда - но тут такие коды ранее уже писал, поищите и сделайте по образцу.

[DiemonStar]

Думаю тут словарь в словаре нужен.

словарь в словаре это для создания универсальной БД. Здесь же по условию задачи не требуется такое. Хватает трех словарей - для счета уникальных, для суммирования и для выделения уникальных значений.

[Hugo121]

Вот приспособил нечто уже ранее написанное:

Sub PereborDatScetov()    ' словарь в словаре
    Dim a, i&, t$, Dic As Object, Dic2 As Object
    Dim el, col

    a = Range("C2", Cells(Rows.Count, "A").End(xlUp)).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
            t = a(i, 2)
            If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary")
            .Item(t).Item(a(i, 1)) = .Item(t).Item(a(i, 1)) + a(i, 3)
        Next
    End With

    For Each el In Dic.keys
        Debug.Print "Дата " & el
        Set Dic2 = Dic.Item(el)
        For Each col In Dic2.keys
            Debug.Print "По ней счёт и сумма " & col & "|" & Dic2.Item(col)
        Next
    Next

End Sub

Результат выводится в окно отладки (Ctrl+G в редакторе).

[strannick]

Спасибо всем принявшим участие в теме. Взял за основу код DiemonStar. В процессе подготовки таблицы с итоговыми данными понадобилось еще выбрать оплаченные/неоплаченные счета по датам. Там было проще, в допстолбце после предобработки были проставлены единички. Вот на всякий случай код с добавкой для таких случаев, может кому понадобиться:

Sub СчетаДатаОпл()
Dim a(), i&
a = [A2].CurrentRegion.Value

Set Dates = CreateObject("scripting.dictionary")
Set Sums = CreateObject("scripting.dictionary")

With CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
    If a(i, 8) = 1 Then
      If Not .Exists(a(i, 1) & "|" & a(i, 3)) Then
        .Item(a(i, 1) & "|" & a(i, 3)) = 1
        Dates.Item(a(i, 3)) = Dates.Item(a(i, 3)) + 1
      Else
        .Item(a(i, 1) & "|" & a(i, 3)) = .Item(a(i, 1) & "|" & a(i, 3)) + 1
      End If
      Sums.Item(a(i, 3)) = Sums.Item(a(i, 3)) + a(i, 2)
    End If
    Next i
End With
If Dates.Count Then [P2].Resize(Dates.Count).Value = Application.WorksheetFunction.Transpose(Dates.Keys)
If Dates.Count Then [Q2].Resize(Dates.Count).Value = Application.WorksheetFunction.Transpose(Dates.Items)
If Dates.Count Then [R2].Resize(Sums.Count).Value = Application.WorksheetFunction.Transpose(Sums.Items)
End Sub

Номера счетов в первом столбце, суммы - во втором, пометка оплаты -в восьмом. Точно так же по неоплаченным (пометка в девятом столбце). Увязать все в коде не получилось. Пока не получилось, что-то туговато у меня со словарями идет. Еще раз всем спасибо!!!