Как разнести заказы клиентов в один общий столбец

[Niki12]

Уважаемые форумчане! Очень нужен макрос! Имеется прайс с большим наименованием товаров, до 8000, и заказ клиента,с указанием товаров и нужного количества этих товаров. Нужно,чтобы макрос в столбец с общим заказом добавил заказ клиента, а если в ячейке уже стоит заказ предыдущего клиента,нужно,чтобы он через запятую добавил заказ настоящего клиента. На самом деле клиентов очень много, я могла бы запускать такой макрос каждый раз после прихода очередного заказа,а сейчас я все это делаю вручную,очень тяжело. Пример в прилагаемом файле. Очень прошу помощи!

[Скрипт]

Niki12, напишите на примере выложенной вами книги, что должен сделать макрос.

Например:

1. пользователь нажимает на кнопку;
2. макрос движется по столбцу "A";
3. берёт данные из ячейки и что дальше?

[staniiislav]

пробуйте, если правильно понял:

Option Explicit

Sub Niki12()
Dim a(), b(), c(), i&, j&, n&
If MsgBox("Произвести поиск?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
a = Range("A2:B" & Cells(Rows.Count, "A").End(xlUp).Row).Value
b = Range("D2:E" & Cells(Rows.Count, "D").End(xlUp).Row).Value
ReDim c(1 To UBound(a), 1 To 1)

Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row).ClearContents
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(b)
        If Not .Exists(b(i, 1)) Then
            .Item(b(i, 1)) = 0& '.Item(b(i, 1))
        End If
    Next i
    For i = 1 To UBound(a)
        If .Exists(a(i, 1)) Then
            For j = 1 To UBound(b)
                If a(i, 1) = b(j, 1) Then
                    If Len(a(i, 2)) Then
                        c(i, 1) = a(i, 2) & ", " & b(j, 2)
                    Else
                        c(i, 1) = b(j, 2)
                    End If
                End If
            Next j
        End If
    Next i
End With
Range("H2").Resize(UBound(c)).Value = c
MsgBox "Поиск завершен.", vbInformation, "Поиск"
End Sub

[Hugo121]

Станислав, кажется перемудрили
Я немного Ваш код изменил.

Sub Niki12()
    Dim a(), b(), c(), il&, i&, t&
    If MsgBox("Произвести поиск?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
    il = Cells(Rows.Count, "A").End(xlUp).Row
    a = Range("A2:A" & il).Value 'где ищем
    b = Range("B2:B" & il).Value 'что будем пополнять
    c = Range("D2:E" & Cells(Rows.Count, "D").End(xlUp).Row).Value 'что ищем, чем пополняем

    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(a): .Item(a(i, 1)) = i: Next i

        For i = 1 To UBound(c)
            If .Exists(c(i, 1)) Then
                t = .Item(c(i, 1))
                If Len(b(t, 1)) Then b(t, 1) = b(t, 1) & ", " & c(i, 2) Else b(t, 1) = c(i, 2)
            End If
        Next i
    End With
    'тут выгружаем назад в B2, но сейчас для теста в H2
    Range("H2").Resize(UBound(b)).Value = b
    MsgBox "Поиск завершён.", vbInformation, "Поиск"
End Sub

Но количество символов в ячейке ограничено - смотрите не превысьте!

[staniiislav]

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

Станислав, кажется перемудрили
Я немного Ваш код изменил.

Sub Niki12()
    Dim a(), b(), c(), il&, i&, t&
    If MsgBox("Произвести поиск?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
    il = Cells(Rows.Count, "A").End(xlUp).Row
    a = Range("A2:A" & il).Value 'где ищем
    b = Range("B2:B" & il).Value 'что будем пополнять
    c = Range("D2:E" & Cells(Rows.Count, "D").End(xlUp).Row).Value 'что ищем, чем пополняем

    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(a): .Item(a(i, 1)) = i: Next i

        For i = 1 To UBound(c)
            If .Exists(c(i, 1)) Then
                t = .Item(c(i, 1))
                If Len(b(t, 1)) Then b(t, 1) = b(t, 1) & ", " & c(i, 2) Else b(t, 1) = c(i, 2)
            End If
        Next i
    End With
    'тут выгружаем назад в B2, но сейчас для теста в H2
    Range("H2").Resize(UBound(b)).Value = b
    MsgBox "Поиск завершён.", vbInformation, "Поиск"
End Sub

Но количество символов в ячейке ограничено - смотрите не превысьте!

Блин, или я не понимаю суть вопросов или (скорое всего), нечего мне мне этими делами программными заниматься, видимо не заточены извилины у меня под программирование

[Hugo121]

Да ну, не расстраивайтесь, Ваш вариант тоже почти работает (не сохраняет те данные, которым нет дополнения).
Просто нужно было в словарь заносить сперва тех, где будем искать, и сразу с их координатами.
Затем перебор тех, кого ищем, и по координатам дополняем строку.
Кстати, в моём коде упущен такой момент - если вдруг в заказе появился товар, которого нет в прайсе, то это просто молча будет игнорировано. Нужно бы хоть сообщение вывести... А лучше собрать в другой словарь с товаром в итем, затем выгрузить под список (и предусмотреть и тут повтор заказов).

[staniiislav]

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

Да ну, не расстраивайтесь, Ваш вариант тоже почти работает (не сохраняет те данные, которым нет дополнения).
Просто нужно было в словарь заносить сперва тех, где будем искать, и сразу с их координатами.
Затем перебор тех, кого ищем, и по координатам дополняем строку.
Кстати, в моём коде упущен такой момент - если вдруг в заказе появился товар, которого нет в прайсе, то это просто молча будет игнорировано. Нужно бы хоть сообщение вывести... А лучше собрать в другой словарь с товаром в итем, затем выгрузить под список (и предусмотреть и тут повтор заказов).

я не расстраиваюсь, просто иногда бесит некоторые ситуации, которые изначально не предусмотрел

[staniiislav]

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

Кстати, в моём коде упущен такой момент - если вдруг в заказе появился товар, которого нет в прайсе, то это просто молча будет игнорировано. Нужно бы хоть сообщение вывести... А лучше собрать в другой словарь с товаром в итем, затем выгрузить под список (и предусмотреть и тут повтор заказов).

все равно пока не могу понять как эти условия выполнить

[staniiislav]

завтра че нить придумаю

[Hugo121]

Ну как - если критерий есть в словаре, то извлекаем координаты и дополняем строку. Если нет в словаре - заносим эти данные в словарь ненайденных, или в другой массив, или сразу пишем на лист. Но проверить на повтор (допустим магазин2 заказал товар150, затем ещё что-то, затем вдруг ещё товар150) проще используя словарь.
Возможно, на практике в данном случае такой случай исключён, но в теории ведь возможен? (сорри за нарочную тавтологию )