Страницы: 1
RSS
Суммирование части уникальных значений ячеек макросом, Подсчет суммы частей диапазона ячеек, с выборкой уникальных
 
Добрый день, столкнулся с очередной проблемой, есть сводная ведомость, с данными конкретной структуры (количество/дата). Необходимо подсчитать итог по столбцам, но:
- если все даты (после "/") равны, то суммируется количество (работает);
- если есть расхождения по датам, то необходимо суммировать каждую дату, и тут проблема, если отличная дата одна и не повторятся, то считает правильно, если отличных дат несколько или они повторяются, то получается ерунда.
помогите с решением проблемы,
заранее спасибо, и да, знаю что опять не угадал с названием темы, приму любое название какое предложите.
Изменено: Irbis_evs - 18.05.2022 15:38:15
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
Добрый день.
Попробуйте таким макросом:
Скрытый текст

Основная идея - сначала по каждому столбцу определяем уникальные элементы после "/" при помощи словаря, потом суммируем по этим элементам все числа до "/"
и пишем все это в массив результатов. Потом массив результатов выгружаем на лист от ячейки D7
Код для данных из примера.
Кому решение нужно - тот пример и рисует.
 
Пытливый, спасибо работает, для полного счастья, выгруженный массив по столбцам в одну ячейку загнать отдельным макросом. или при выгрузке проще сцепить?
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
удалил, нашел ошибку.
Изменено: V - 18.05.2022 16:45:44
 
V, , Спасибо, то что надо.
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
Irbis_evs, В коде есть ошибка. Не учел 2/8.
Изменено: V - 18.05.2022 16:52:34
 
Если сцепить в 1 ячейку, то, вроде в этой строке надо:
Код
 arrOut(1, lngJ) = arrout(1,lngJ) & Chr(10) & lngS & "/" & Uniq.Item(arrK(lngK)): lngS = 0
Кому решение нужно - тот пример и рисует.
 
сумма, мой вариант отрабатывает только если все значения в столбце одинаковы
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
Пытливый, Да, спасибо
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
Пытливый,  в продолжение вопрос, вместо D7 чтобы вставлял в следующую после последней занятой, подскажете?
Заранее спасибо
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
подправил:
Код
Sub итог_now()
Dim Baza()
'Sheets("Сводная").Activate
lk = Sheets("Сводная").Cells(Rows.Count, 3).End(xlUp).Row
ls = Sheets("Сводная").Cells(2, Columns.Count).End(xlToLeft).Column
Baza = Range(Cells(3, 4), Cells(lk, ls)).Value
Set sd = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Baza, 2)
    For j = 1 To UBound(Baza, 1)
        If sd.Exists(Baza(j, i)) Then
            sd.Item(Baza(j, i)) = sd.Item(Baza(j, i)) + 1
        Else
            sd.Item(Baza(j, i)) = 1
        End If
    Next
    For Each K In sd.keys
        If IsEmpty(K) Then Exit For
        If IsEmpty(m) Then
            m = sd.Item(K) * Split(K, "/")(0) & Mid(K, 2, 99)
        Else
            m = m & "; " & sd.Item(K) * Split(K, "/")(0) & Mid(K, 2, 99)
        End If
    Next
    Cells(lk + 10, i + 3) = m
    sd.RemoveAll
    m = Empty
Next
End Sub
 
V, Спасибо.
Спасибо за помощь, двое суток ломал над этим голову.
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
Еще вариант

Код
Sub tt()
    r0_ = 3
    c0_ = 4
    nr_ = Cells(Rows.Count, c0_ - 1).End(3).Row - r0_ + 1
    nc_ = Cells(r0_ - 1, Columns.Count).End(1).Column - c0_ + 1
    ar = Cells(r0_, c0_).Resize(nr_, nc_).Value
    ar1 = Cells(r0_ + nr_, c0_).Resize(, nc_).Value
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        On Error Resume Next
        For j = 1 To nc_
            For i = 1 To nr_
                sp_ = Split(ar(i, j), "/")
                .Item(sp_(1)) = .Item(sp_(1)) + Val(sp_(0))
            Next i
            For Each k_ In .keys
                ar1(1, j) = ar1(1, j) & vbLf & .Item(k_) & "/" & k_
            Next k_
            ar1(1, j) = Mid(ar1(1, j), 2, 999)
            .RemoveAll
        Next j
        On Error GoTo 0
    End With
    Cells(r0_ + nr_, c0_).Resize(, nc_) = ar1
End Sub

Чуть исправил. Добавил строку
Код
ar1(1, j) = Mid(ar1(1, j), 2, 999
Изменено: _Boroda_ - 18.05.2022 17:17:01
Скажи мне, кудесник, любимец ба’гов...
 
Код
'вместо
'[d7].Resize(UBound(arrOut, 1), UBound(arrOut, 2)) = arrOut
Cells(Rows.count,4).end(xlup).Offset(1,0).Resize(UBound(arrOut, 1), UBound(arrOut, 2)) = arrOut

По 4 столбцу определяем последнюю заполненную, затем смещаемся вниз на строку (Offset) и далее определяем область для вставки через Resize
Изменено: Пытливый - 18.05.2022 17:05:44
Кому решение нужно - тот пример и рисует.
 
Цитата
Пытливый написал:
По 4 столбцу определяем последнюю заполненную
По четвертому нельзя. Там могут быть пустые (см. столбец L). По третьему
Скажи мне, кудесник, любимец ба’гов...
 
_Boroda_,  спс, попробую.
Пытливый,  спс.
всем спс, я отошел, пока остановился на варианте V, надо листинг еще внимательно почитать, может разберусь что к чему.
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
_Boroda_, точно. По третьему.
Кому решение нужно - тот пример и рисует.
 
Цитата
Irbis_evs написал:
пока остановился на варианте V,
А у Вас в таблице количество всегда однозначное? Не может быть, например, такого варианта - 11/8,20 ?
Скажи мне, кудесник, любимец ба’гов...
 
_Boroda_,  может, причем легко, также в варианте от V столкнулся с тем, что при большом количестве строк вылетала ошибка в строке
Код
m = m & "; " & sd.Item(K) * Split(K, "/")(0) & Mid(K, 2, 99)
пришлось изменить ее на
Код
m = m & "; " & sd.Item(K) * Split(K, "/")(0) & Mid(K, 2, 9999)
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
Irbis_evs, ваша правка не имеет отношения к количеству строк, если что.
Изменено: V - 19.05.2022 10:10:02
 
V, может быть я так и не разобрался в коде до конца, нашел еще небольшую ошибку, при создании ведомости ВКПО в графе Носки летн. в итогах к количеству добавляется дополнительная цифра "2", с чем это связано? в остальных такого нет, только в этой графе.
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
А я предупреждал?
Цитата
_Boroda_ написал:
А у Вас в таблице количество всегда однозначное? Не может быть, например, такого варианта - 11/8,20 ?
Думаете, просто так написал? Смотрите 21-ю строку кода, который Вы взяли в работу. Вот с ней и связано

Цитата
V написал:
& Mid(K, 2, 99)
Скажи мне, кудесник, любимец ба’гов...
 
_Boroda_,  спасибо, в итоге взял Ваш вариант решения.  
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
Страницы: 1
Наверх