Karamantak (Все сообщения пользователя)

Суммирование данных по выбору, С двух листов сумма на третий через фильтр

Пользователь

Сообщений: 9 Регистрация: 27.01.2014

11.12.2017 23:28:29

Добрый вечер!
Помогите, пожалуйста, решить задачу. Нужно просуммировать данные с двух листов и вставить в третий, но не по всем показателям, а по выбору (типо как по фильтру). Сумму всего подряд понятно как сделать, а вот по критериям не допру никак.

Представляю себе это так: Нужно добавить userform куда будет вытягиваться параметры для выбора суммирования по нескольким столбцам (например столбец E сцепить столбец F) галочками пометить по каким критериям суммировать и сумму уже вставить в Лист4Sum, т.е. какие-то строчки суммировать полностью, а какие-то по критерию отбора.

Через If пробовал делать, но каждый элемент столбца F не возможно указать, потому как он может меняться, т.е. которые не указал в IF будут пропускаться... Короче конкретный затык на этом моменте...

Код

Sub summa()
Dim arr(), arr1(), arr2(), i&, j&
arr = Sheets("Лист2").UsedRange.Value
arr1 = Sheets("Лист3").UsedRange.Value
arr2 = Sheets("Лист4Sum").UsedRange.Value
 
For i = 5 To UBound(arr2)
    For j = 10 To UBound(arr2, 2)
        arr2(i, j) = arr(i, j) + arr1(i, j)
    Next
Next
 
Sheets("Лист4Sum").UsedRange.ClearContents
Sheets("Лист4Sum").Range("A1").Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
 
End Sub

Перейти

Копирование из листа на лист по нескольким критериям

Karamantak

Пользователь

Сообщений: 9 Регистрация: 27.01.2014

25.11.2017 14:29:14

(i, 5) - в ячейках текст (например Общий, Частный и т.п.)
(j, 2) - дата (01.01.18, 01.02.18 и т.д.)
Arr(i, j) - там числа, которые должны суммироваться по месяцам (например "Общий" в "01.02.18" в разных строках 0,222, 1,25, 2,555 т.е. в Arr2(i,j)=4,027)
Есть пустые строчки и получается некоторые макрос суммирует, на некоторых вылазит ошибка, хотя в Arr(i, 5) данные абсолютно одинаковые...
и почему тогда, когда проверяю через F8, то все нормально, ошибки нет?

Перейти

Копирование из листа на лист по нескольким критериям

Karamantak

Пользователь

Сообщений: 9 Регистрация: 27.01.2014

25.11.2017 14:02:15

Приспособил макрос к другой задаче, при переборе строк выдает ошибку то в одной строке, то в другой, type mismatch 13, хотя если смотреть через F8, то ошибки как бы нет. Не подскажете почему так может быть?

Код

Sub Proba45()Dim i&, j&,  Arr(), Arr2 As Worksheet, a1, b1
Dim MySum As Object, Kei$
Set MySum = CreateObject("Scripting.Dictionary")
 
Arr = Sheets("Лист2").UsedRange.Value
a1 = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row
b1 = Sheets("Лист1").Cells(1, Sheets("Лист1").Columns.Count).End(xlToLeft).Column
Set Arr2 = Sheets("Лист1")
 
For i = 4 To UBound(Arr)
    For j = 10 To UBound(Arr, 2)
        If Len(Arr(i, 5)) Then
            Kei = Arr(i, 5) & "|" & Arr(2, j)
            MySum(Kei) = MySum(Kei) + Arr(i, j) ' Тут вылазит ошибка в разных строках (то 45, то 191, то еще какая)
        End If
    Next
Next
 
For i = 2 To a1
    For j = 2 To b1
        Kei = Arr2.Cells(i, 1) & "|" & Arr2.Cells(1, j)
            If MySum.exists(Kei) Then
                Arr2.Cells(i, j) = MySum(Kei)
                Else
                Arr2.Cells(i, j) = Empty
            End If
    Next
Next
End sub

Изменено: Karamantak - 25.11.2017 14:03:16

Перейти

Копирование из листа на лист по нескольким критериям

Karamantak

Пользователь

Сообщений: 9 Регистрация: 27.01.2014

07.11.2017 22:16:34

А можно ли несколько ключей задать и в зависимости от значения в одном столбце, суммирование данных по определенному ключу? Пробовал по разному но не получилось... Вторую часть не могу придумать, да и в первой явно что-то не так делаю...

Код

Sub Proba5()    Dim i&, ii&, Arr(), MyArr()
    Dim MySum As Object, Kei$, Kei1$, Kei2$, Kei3$
    Set MySum = CreateObject("Scripting.Dictionary")
    Arr = Sheets(1).UsedRange.Value
    For i = 2 To UBound(Arr)
        If Len(Arr(i, 2)) Then
            Arr(i, 5) = Format(Arr(i, 5), "dd.mm.yyyy")
            If Arr(i, 3) = "нов" Then
            Kei1 = Arr(i, 1) & "|" & Arr(i, 3) & "|" & Arr(i, 4) & "|" & Arr(i, 5)
                ElseIf Arr(i, 3) = "збс" Then
                Kei2 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(i, 4) & "|" & Arr(i, 5)
                    ElseIf Arr(i, 3) = "впр" Then
                    Kei3 = Arr(i, 1) & "|" & Arr(i, 3) & "|" & Arr(i, 5)
            MySum(Kei) = MySum(Kei1) + MySum(Kei2) + MySum(Kei3) + Arr(i, 6)
            'MySum(Kei) = MySum(Kei) / 1000
        End If
    Next
    With Sheets(2)
        MyArr = .UsedRange.Value
        For i = 3 To UBound(MyArr)
            For ii = 4 To UBound(MyArr, 2)
             MyArr(2, ii) = Format(MyArr(2, ii), "dd.mm.yyyy")
                Kei = MyArr(i, 1) & "|" & MyArr(i, 2) & "|" & Arr(i, 3) & "|" & MyArr(2, ii)
                If MySum.exists(Kei) Then
                    MyArr(i, ii) = MySum(Kei)
                Else
                    MyArr(i, ii) = Empty
                End If
            Next
        Next
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(MyArr), UBound(MyArr, 2)).Value = MyArr
    End With
End Sub

Перейти

Копирование из листа на лист по нескольким критериям

Karamantak Пользователь Сообщений: 9 Регистрация: 27.01.2014	# 05.11.2017 18:07:25 Получается суммируется все, независимо, что в одном из столбцов нет данных... Не могу допереть, как пропустить строчку, если в одном из столбцов пустая ячейка, подскажите, пожалуйста)
	Перейти

Копирование из листа на лист по нескольким критериям

Karamantak Пользователь Сообщений: 9 Регистрация: 27.01.2014	# 05.11.2017 14:49:23 Спасибо большое!
	Перейти

Копирование из листа на лист по нескольким критериям

Karamantak Пользователь Сообщений: 9 Регистрация: 27.01.2014	# 05.11.2017 14:02:46 Да, Hugo, большое спасибо!
	Перейти

Копирование из листа на лист по нескольким критериям

Karamantak

Пользователь

Сообщений: 9 Регистрация: 27.01.2014

05.11.2017 12:48:58

Доброго времени суток, знатоки.
На 1 листе есть данные, которые надо суммировав по условию, записать на другой лист, также в определенные ячейки.
Формулами вроде как реализовал, макросом не получается....
Сопоставляю 3 критерия и, в случае совпадения, по номеру суммируются данные и вставляются в нужные ячейки.
Количество строк всегда разное(добавляются/удаляются), столбцы статичны, но в разных файлах местами по-разному стоят..

Изменено: Karamantak - 05.11.2017 12:49:15

Перейти

Сравнение значений из разных вкладок, Сравнение диапазона и при совпадении вставка данных

Karamantak

Пользователь

Сообщений: 9 Регистрация: 27.01.2014

27.01.2014 21:55:59

Добрый вечер всем!

Пятый день, как начал изучать макросы, так что не судите строго)
Есть файл, в нем 3 листа, в лист1 - 4 столбца, в лист2 - 3 столбца, в лист3 - 2 столбца.

Условие "лист1(B=1)": если лист1(А:А)=лист2(А:А) то с лист2(B,C) необходимо заполнить данные в лист1(C,D), причем если в лист2(B,C) несколько строчек с одним и тем же номером, то нужна сумма этих данных.

Условие "лист1(B=2)": если лист1(А:А)=лист3(А:А) то с лист2(B) необходимо заполнить данные в лист1©, причем если в лист3(B) несколько строчек с одним и тем же номером, то нужна сумма этих данных.

В приложенном файле в ячейках значение 1, значение 2, стоят экселевские формулы, но хотелось бы через макрос. Сам пробовал с помощью справочников, учебников, через Range, но что-то пока не совсем то получается, как хотелось бы...

Такой вот есть код:

Код

Sub макрос()
Dim i As Integer
i = 1
Do While Not (IsEmpty(Worksheets("Лист1").Cells(i, 1)))
If Worksheets("Лист1").Cells(i, 1) = Worksheets("Лист2").Cells(i, 1) Then
       If Worksheets("Лист1").Cells(i, 2) = 1 Then
             Worksheets("Лист1").Cells(i, 9) = Worksheets("Лист2").Cells(i, 2).Value
     End If
End If
If Worksheets("Лист1").Cells(i, 1) = Worksheets("Лист2").Cells(i, 1) Then
       If Worksheets("Лист1").Cells(i, 2) = 1 Then
             Worksheets("Лист1").Cells(i, 10).Value = Worksheets("Лист2").Cells(i, 3).Value
     End If
End If
If Worksheets("Лист1").Cells(i, 1) = Worksheets("Лист3").Cells(i, 1) Then
       If Worksheets("Лист1").Cells(i, 2) = 2 Then
             Worksheets("Лист1").Cells(i, 9) = Worksheets("Лист3").Cells(i, 2).Value
     End If
End If
i = i + 1
Loop
End Sub

Но этот код не совсем подходит...

Заранее благодарю!

Изменено: Karamantak - 27.01.2014 22:08:10

Перейти