Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
СуммЕсли по двум столбцам, но макросом
 
#1
16.02.2013 15:14:38
Добрый день.
Есть позиции и материалы по группам на определенную сумму. Сделал макросом конкатенацию 2 столбцов, другим макросом выбрал только уникальные значения, третьим делаю СуммЕсли но в поле "критерий" не могу подставить поочередно значения из массива уникальных позиций.
Пример прилагаю, в Модуле1 находятся мои попытки) чувствую что разгадка близка но увы, так что прошу помощи.
Если можно сделать 1 макросом не выгружая промежуточные данные на лист а только результаты буду благодарен!
 
 
 
#2
16.02.2013 15:34:42
Вам нужна совместимость с 2003?
Для .xlsx (.xlsm) есть функция СУММЕСЛИМН:
Код
=СУММЕСЛИМН(N:N;E:E;E2;F:F;F2)

или обязательно макрос?
Изменено: Михаил С. - 16.02.2013 15:35:51
 
 
 
#3
16.02.2013 15:41:19
Да, суть в том что после обработки данных я делаю промежуточные итоги, и неизвестно в каких ячейках надо будет вставлять сумму. поэтому обязательно макросом.
 
 
 
#4
16.02.2013 16:48:44
Макрос, так макрос..
 
 
 
#5
16.02.2013 22:05:17
Сасибо, посмотрел. Наверное Вас ввели в заблуждение вспомогательные данные которые я выгрузил на лист макросами. Суть в том чтоб проставить суммы под ячейкой со словом "получается" в примере. Т.е. в ячейке О23 должна быть сумма по позиции со столбца N - 2816,27 минус сумма по позиции со столбца K деленная на ячейку М23. Это я сделал, с помощью Cell.offset, пройдясь циклом for each для столбца Е.
в О22 должна быть сумма чисел столбца N соотв 4др в столбце F и ключу 5203222 в столбце Е минус сумма чисел столбца K соотв 4др в столбце F и ключу 5203222 деленная на ячейку М23
и так до О19, где вычисляются данные для типа 1ос и ключа 5203222
Прошу посмотреть макросы которые я мучил, там в SumIF в критерий поиска надо как то подставить поочередно значения массива с уникальными значениями и заработает (
 
 
 
#6
16.02.2013 23:48:04
Цитата
Дмитрий Тарковский пишет:
Т.е. в ячейке О23 должна быть сумма по позиции со столбца N - 2816,27 минус сумма по позиции со столбца K деленная на ячейку М23. Это я сделал, с помощью Cell.offset, пройдясь циклом for eachдля столбца Е.
в О22 должна быть сумма чисел столбца N соотв 4др в столбце F и ключу 5203222 в столбце Е минус сумма чисел столбца K соотв 4др в столбце F и ключу 5203222 деленная на ячейку М23
и так до О19, где вычисляются данные для типа 1ос и ключа 5203222
Ни чего не понял, особенно про деленная на ячейку М23 - в М23 тескт...

Покажите, какие результаты вы хотите получить и чем они отличаются от моих.
 
 
 
#7
16.02.2013 23:56:52
Я просил выгрузить суммы в тех местах где я указал "формулой" и " надо". Мне б только чтоб правильно суммы выгружать научится а там дальше буду аналогично выгружать еще по другому столбцу также и делить, но там надеюсь сам справлюсь по методу аналогии.
Прикрепил чуть доработаный файлик.  Обратите внимание на макрос mb  и его работу. Только он выгружает одни и те же данные для всех итогов а надо чтоб менялись...
 
 
 
#8
17.02.2013 00:20:55
Опять не понял, что же вам нужно.
Уберите работу макросов и покажите вручную, что и где вы хотите получить.
как я вижу - мои результаты не отличаются от ваших... только, может быть, расположены не там..
 
 
 
#9
17.02.2013 00:23:37
Ваши результаты правильны, только расположены не там, выделил зеленым так и где надо
 
 
 
#10
17.02.2013 00:28:27
вот так тоже самое, но чуть короче и читабельнее
Код
Sub mb()
    Dim myArr(), i As Long
    myArr() = Range("U2:U692").Value
For Each cell In [E2:E100]
n = 1
            MyStr = Right(cell.Value, 4)
        With WorksheetFunction
                If MyStr = "Итог" Then
                    cell.Offset(-4, 10).Value = .SumIf([V:V], myArr(n, 1), [N:N]):
                    cell.Offset(-3, 10).Value = .SumIf([V:V], myArr(n + 1, 1), [N:N]):
                    cell.Offset(-2, 10).Value = .SumIf([V:V], myArr(n + 2, 1), [N:N]):
                    cell.Offset(-1, 10).Value = .SumIf([V:V], myArr(n + 3, 1), [N:N])
                End If
         End With
         
n = n + 4
    Next cell
End Sub
Изменено: Михаил С. - 17.02.2013 00:29:40
 
 
 
#11
17.02.2013 00:35:26
Для всех итогов выгружает одни и те же данные - как для первого. Т.е. для первой позиции считает правильно а для остальных ставит те же данные что для первой., а надо чтоб в ячейке О43 было n =5 и дальше 5+1 и тд
 
 
 
#12
17.02.2013 01:00:31
так?
 
 
 
#13
17.02.2013 01:16:05
Да! здорово, вот только нюанс  - у меня таких итогов 180 в другой день может быть 200. Для 180-ти макрос работал примерно 5 минут, но все равно главное результат. Огромное спасибо, буду вникать до чего сам не дошел :)
 
 
 
#14
17.02.2013 01:26:16
А как можно  вместо V:V в WorksheetFunction.SumIf([V:V], Line, [K:K]) подставить сам массив, чтоб не выгружать его на лист?
 
 
 
#15
17.02.2013 02:06:04
Цитата
Дмитрий Тарковский пишет:
5 минут
попробуйте такой вариант:
Код
Sub t()
  Dim lc As Range, a(), n(), o(), d As Object, v, i&, j&, k&, l&, it()
  Set lc = Cells(Rows.Count, 5).End(xlUp)
  a = Range([e2], lc.Offset(, 1)).Value
  n = Range([n2], Cells(lc.Row, "n")).Value
  ReDim o(1 To UBound(a), 1 To 1)
  ReDim it(1 To UBound(a), 1 To 2)
  Set d = CreateObject("scripting.dictionary")
  
  For i = 1 To UBound(a)
    If Not IsEmpty(a(i, 2)) Then
      d.Item(a(i, 1) & a(i, 2)) = d.Item(a(i, 1) & a(i, 2)) + n(i, 1)
    Else
      k = k + 1: it(k, 1) = a(i, 1): it(k, 2) = i
    End If
  Next
  For j = 1 To k
    l = -4
    For Each v In d.keys
      If Left(v, 7) = Left(it(j, 1), 7) Then o(it(j, 2) + l, 1) = d.Item(v): l = l + 1
    Next
  Next
  [o2].Resize(UBound(a)).Value = o
End Sub

про квадратики перед Value помните?
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#16
17.02.2013 02:34:35
Да, я через нотпад++ пропустил ток так и увидел)
Опять Вы меня выручили ikki! Скорость мгновенная, но из предыдущего примера я понял как доработать результат, а тут возник вопрос.
Выгружается сумма из столбца N, в конечном итоге нужно чтоб выгружался результат действий сумма ключа+1ос по столбцу N  -  сумма ключа+1ос по K / на значение в столбце L с тем же ключем и типом.  например для ячейки О19: (1438,645 - 1438,645) / значение в столбце L (L23 например)
 
 
 
#17
17.02.2013 02:40:14
Цитата
Дмитрий Тарковский пишет:
/ на значение в столбце L с тем же ключем и типом
у вас там одни черточки.  :oops:
в принципе, ничего невозможного нет.
но, наверное, надо будет еще один словарь завести и пару массивов.
вот только про
Цитата
L23 например
пойму чего-нибудь...  :)
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#18
17.02.2013 02:43:27
добавил y = Range([k2], Cells(lc.Row, "y"  ;)  ).Value
и заменил d.Item(a(i, 1) & a(i, 2)) = d.Item(a(i, 1) & a(i, 2)) + n(i, 1)
на d.Item(a(i, 1) & a(i, 2)) = d.Item(a(i, 1) & a(i, 2)) + n(i, 1) - y(i, 1)
метод тыка оправдывает себя! ) надо теперь еще поделить на "L"
Вот еще добавил
x= Range(a(i, 1) & a(i, 2), Cells(lc.Row, "L"  ;)  ).Value
d.Item(a(i, 1) & a(i, 2)) = d.Item(a(i, 1) & a(i, 2)) + (n(i, 1) - y(i, 1)) / x(i, 1) - теперь считает что надо!))
Эмоций капец - как будто сам придумал. Спасибо Вам огромное!
Изменено: Дмитрий Тарковский - 17.02.2013 02:49:48
 
 
 
#19
17.02.2013 02:58:50
Цитата
Дмитрий Тарковский пишет:
добавил
Код
y = Range([k2], Cells(lc.Row, "y").Value
тот "y", который здесь в кавычках - это столбец листа.
вам столько не надо. достаточно "L".
Цитата
Дмитрий Тарковский пишет: надо теперь еще поделить на "L"
а там ещё проще
переписываем строчку:
Код
ReDim it(1 To UBound(a), 1 To 3)

добавляем одну команду:
Код
k = k + 1: it(k, 1) = a(i, 1): it(k, 2) = i: it(k,3)=y(i,2)

и, соответственно, переписываем так:
Код
o(it(j, 2) + l, 1) = d.Item(v) / it(j,3)

всё.

пс. данный макрос будет корректно работать только (sic !) для семизначных строк в столбце E. иначе нужно будет править код, повышая универсальность.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#20
17.02.2013 03:00:03
Цитата
Дмитрий Тарковский пишет:
Вот еще добавил
тоже вариант.
замечательно.

upd стоп. я как-то по-другому понял вашу хотелку. что вам надо итог суммы разниц делить на значение в столце L в итоговой строке...
а в вашем варианте получается сумма делений. это может быть не одно и то же. от цифр зависит.
ваша логика вам виднее, конечно, но всё же тестируйте результаты без эмоций, плиз  ;)
Изменено: ikki - 17.02.2013 03:05:25
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#21
17.02.2013 03:21:58
да, и кстати!
Цитата
Дмитрий Тарковский пишет:
Опять Вы меня выручили ikki! Скорость мгновенная
ничего бы не получилось, если бы Михаил С. и Sergei_A не вытрясли бы из вас вашу же задачу во всей её неповторимой красоте.
к счастью (моему), я попал в эту тему в удачный момент - когда уже всё было выяснено.
так что спасибо вы, в первую очередь, должны им.

а ускорить готовый алгоритм - дело нехитрое  8)
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#22
17.02.2013 03:43:46
Лично я просто психанул.  :o  
У меня такой вариант получился, по выданному примеру

Код
Sub Sum_Unic()
Dim Arr(), i&, Str$
Dim Unic()
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")
With Sheets("Лист1")
    Arr = Intersect(.UsedRange, .Range("E:N"))
        For i = 2 To UBound(Arr)
            If Arr(i, 1) Like "*Итог*" Then
               Unic = oDict.Items
               .Cells(i - oDict.Count, 15).Resize(oDict.Count) = WorksheetFunction.Transpose(Unic)
              oDict.RemoveAll
              i = i + 1
            End If
          Str = Arr(i, 1) & " " & Arr(i, 2)
  With oDict
            If .exists(Str) Then
                .Item(Str) = .Item(Str) + Arr(i, 10)
            Else
                On Error Resume Next
                .Add Key:=Str, Item:=Arr(i, 10)
            End If
     End With
   Next
End With
End Sub



Если показать, где еще находятся числа, что на что делить и куда выгружать, то легко переделать.
Изменено: Михаил С. - 17.02.2013 04:15:01
 
 
 
#23
17.02.2013 03:44:47
Конечно спасибо всем! просто именно Вы уже второй раз выручили, а то сижу голову ломаю по пару дней)
 
 
 
Страницы: 1
Читают тему
Наверх