Страницы: 1
RSS
Оставить только уникальные , а данные их количества сложить
 
Имеется список деталей с размерами и количеством , детали повторяются , можно ли оставить только уникальные , а их количество сложить?
Попробую пример прикрепить
Сори еще раз
Изменено: vintop - 04.04.2015 11:27:02 (Не тот файл)
 
Код
Sub Otbor()
    Dim i%, j&, n&
    Dim a, k&
        With Worksheets("Лист2")
        n = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range(.[a5], .Cells(n, 7)).ClearContents
    End With
    With Worksheets("Лист1")
        n = .Cells(Rows.Count, 3).End(xlUp).Row
        a = .Range(.[c3], .Cells(n, 9))
    End With
    With CreateObject("Scripting.Dictionary")
        On Error Resume Next
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                n = .Item((a(i, 1)))
                a(n, 7) = a(n, 7) + a(i, 7)
                
            Else
                k = k + 1
                .Item((a(i, 1))) = k
                For j = 1 To 7: a(k, j) = a(i, j): Next
            End If
        Next i
    End With
    Worksheets("Лист2").[a5].Resize(k, 7) = a
    a = Empty
End Sub
Изменено: KuklP - 04.04.2015 09:55:48
Я сам - дурнее всякого примера! ...
 
А если сводной?
 
Спасибо , почти работает.Пропали две строчки?Сравнение идет по столбцу A?
 
Сори по С?А как сравнить по С и по F?
 
Первый вариант прост и хорошь , как подправить?
 
Предлагаю такой вариант.
 
Код
Sub Otbor()
    Dim i%, j&, n&
    Dim a, k&
        With Worksheets("Лист2")
        n = .Cells(Rows.Count, 2).End(xlUp).Row
        .Range(.[a5], .Cells(n, 10)).ClearContents
    End With
    With Worksheets("Лист1")
        n = .Cells(Rows.Count, 3).End(xlUp).Row
        a = .Range(.[c3], .Cells(n, 9))
    End With
    With CreateObject("Scripting.Dictionary")
        On Error Resume Next
        For i = 1 To UBound(a)
            If .exists(a(i, 1) & "|" & a(i, 4)) Then
                n = .Item(a(i, 1) & "|" & a(i, 4))
                a(n, 7) = a(n, 7) + a(i, 7)
                
            Else
                k = k + 1
                .Item(a(i, 1) & "|" & a(i, 4)) = k
                For j = 1 To 7: a(k, j) = a(i, j): Next
            End If
        Next i
    End With
    Worksheets("Лист2").[a5].Resize(k, 7) = a
    a = Empty
End Sub
Я сам - дурнее всякого примера! ...
 
Спасибо , последний вариант работает вроде корректно буду тестить.
 
Остановился на последнем варианте , всем большое спасибо за помощь!
 
возник по ходу один тревожащий очень сильно вопрос!
сколько ключей может вместить в себя Словарь??
- а то вот собираю словарь - он мне заявляет, что у него Count 310 Item-ов (k)... (в Locals заявляет)...
НО заполняет только 256 и останавливается "Subscript out of range"
- верно ли я понимаю, что он взять больше не может... или проблему искать в другом...
т е вопрос на уточнение: нет ли лимита 256 ключей для Словарей??... и для Коллекций (на всякий случай - если придётся искать др подход) ??
Изменено: JeyCi - 05.04.2015 14:25:43
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Проверил коллекцию на 500 значений: .Count показывает 500, хотя в Locals отображается только 256
 
ЗАМЕЧАТЕЛЬНО)) - поставила до заполнения Словаря:
Код
On Error Resume Next
- всё прошло гладко, и потом всё выгрузил полностью... - ошибку уже не выдаёт. Спасибо
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
JeyCi, К-во значений в словаре, коллекции ограничивается только объемом памяти компа. Так что ошибка у Вас не из-за этого. Я бы не стал использовать On Error Resume Next, пока не выяснена причина ошибки. Иначе рискуете попасть на непредсказуемые результаты.
Я сам - дурнее всякого примера! ...
 
согласна, это крайний вариант 8) - если найду первопричину - отпишусь...
но пока вроде отработал корректно с моими данными
(файл просто не мой - текстовик, загруженный из net - ещё не поняла, что с ним)
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
KuklP, спасибо за беспокойство, разобралась на всякий случай - выгружает всё (хоть в Locals и показывает только 256) - ошибку при заполнении выдаёт на последней строке, которая звучит *** END OF REPORT *** - сама по себе меня не интересует - дальше не разбиралась, что там с ней... после неё уже ничего нет, да и она сама ценности не представляет в качестве ключа
Изменено: JeyCi - 05.04.2015 21:31:34
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Страницы: 1
Наверх