Перенос данных на другой лист

[Palomnik1096]

Суть программы, на листе имеются код клиента и его задолженность, при этом код клиента может повторяться, необходимо посчитать общую сумму долга и отразить код клиента и сумму долга в отдельных ячейках на другом листе. Вот который написал, он считает общую сумму по всем клиентам, но не могу разделить это по клиентам. Все необходимо сделать в цикле For next, ну если сделаете в Do, сильно не обижусь, для общего развития тоже пойдет.
Public Sub éöéöé11()
With Range("A2")
kod = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With
qwe = 0
For i = 1 To kod
kodn = Range("A2").Offset(i, 0)
cena = Range("B2").Offset(i, 0)
If Range("A2").Offset(i, 0) = kodn Then
qwe = qwe + cena
End If
Next i
End Sub
Если можно в кратце объясните смысл для тупых!!!

[Hugo121]

Используйте словари или коллекции.
Вот пример со словарём, делает что-то подобное.

Option Explicit

Sub Otbor()
    Dim a(), oDict As Object, i As Long, temp As String
    
    a = Range("a1:c" & Range("C" & Rows.Count).End(xlUp).Row).Value

    Set oDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
        'temp = Trim(CStr(a(i, 3)))
        temp = Trim(a(i, 3))        
        If Not oDict.Exists(temp) Then
            oDict.Add temp, CStr(a(i, 2))
        Else
            oDict.Item(temp) = CStr(--oDict.Item(temp) + a(i, 2))
        End If
    Next

    With ThisWorkbook.Worksheets(1)
        .Range("D1").Resize(oDict.Count) = Application.Transpose(oDict.keys)
        .Range("E1").Resize(oDict.Count) = Application.Transpose(oDict.items)
    End With

End Sub

Код пробегает по массиву из диапазона и собирает уникальные с суммой в словарь. Если такое значение в словаре уже есть - добавляет к сумме следующую сумму.
В конце выгружает уникальные и суммы рядом в два столбца.

[Palomnik1096]

к сожалению в своем самостоятельном обучении, до массивов и словарей не дошел, поэтому ничего не понял, но за ответ спасибо огромное!!!

[Hugo121]

Если нужно разделить по неизвестному количеству уникальных (заранее неизвестных), то без словаря или коллекции не обойдётесь.
Хотя можно подобие этого на массиве сообразить, но больно медленная конструкция получится - каждого нового прогонять через массив, потом Redim Preserve ему...

[tae1980]

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

к сожалению в своем самостоятельном обучении, до массивов и словарей не дошел, поэтому ничего не понял, но за ответ спасибо огромное!!!

Я бы решил так.
Плюсы такого решения в том что можно строить любые проверки, сравнения и т.п. Ограничение только фантазия. При этом ни какие дополнительные структуры не создаются (что в теории должно экономить оперативную память .
Минусы в том что вся "сводка" просматривается для каждой строки "клиент", что в теории может занять значительное время при большом количестве записей (хотя простейший механизм оптимизации я вставил). Но на практике все происходит весьма быстро, так как вся информация в памяти и нет обращений к диску. К тому же комп поступает почти так же при любой реализации, только ты этого не видишь.

[Palomnik1096]

Нашел решение своей задачи, код не мой, нашел в инете, немного переделал под себя, НО 95% кода не мои, мне кажется все-таки он как-то понятней. Вот сам код

Public Sub Пример13()


List2 = "Лист2" ' Лист со всеми покупками отсортированными по коду покупателя
List3 = "Лист3" ' Лист куда помещаем суммарные покупки
SumMin = 2000 ' Граничная сумма для учета
AKod = "A2" ' Первая ячейка с кодом покупателя
ASum = "B2" ' Первая ячейка с суммой
KKod = "A" ' Столбец с кодами на листе с результатом
KSum = "B" ' Столбец с суммами на листе с результатом
RKod = "A2" ' Первая ячейка с кодом покупателя на листе с результатом
RSum = "B2" ' Первая ячейка с итоговой суммой покупателя на листе с результатом

Sheets(List3).Columns(KKod).ClearCo ntents ' Чистим столбцы от прежних результатов
Sheets(List3).Columns(KSum).ClearCo ntents

Sheets(List2).Select

i = 0
j = 0

Do While Range(AKod).Offset(i, 0) <> ""
TSum = 0
TKod = Range(AKod).Offset(i, 0)

Do While TKod = Range(AKod).Offset(i, 0)
TSum = TSum + Range(ASum).Offset(i, 0)
i = i + 1
Loop

If TSum >= SumMin Then
Sheets(List3).Range(RKod).Offset(j, 0) = TKod
Sheets(List3).Range(RSum).Offset(j, 0) = TSum
j = j + 1
End If

Loop

Sheets(List3).Select
End Sub