Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
VBA СУММЕСЛИ с циклом
 
Добрый день!

Есть два листа:
Sheet1 - исходные данные
Sheet2 - таблица, которую нужно заполнить

Нужно прописать в VBA макрос, который бы с помощью функции суммесли(sumif) выдавал данные сразу для 12 месяцев.
Получается прописать это для одного месяца:
Код
Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integer

nr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).Row 

Name= "A:A"
Jan = "B:B"

For i = 2 To nr
Value = Worksheets("Sheet2").Range("A" & i)
Range("B" & i) = WorksheetFunction.SumIf(Worksheets("Sheet1").Range(Name), Value, Worksheets("Sheet1").Range(Jan))
Next i
End Sub

Каким-то образом нужно прописать цикл для месяцев? Не могу одолеть
 
Код
Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integernr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).RowName = "A:A"
Jan = "B:B"
Dim y As LongFor i = 2 To nr
    Value = Worksheets("Sheet2").Range("A" & i)
    y = 0
    On Error Resume Next
        y = WorksheetFunction.Match(Value, Worksheets("Sheet1").Range(Name), 0)
    On Error GoTo 0
    If y = 0 Then
        Range("B" & i) = 0
    Else
        Range("B" & i) = WorksheetFunction.Sum(Worksheets("Sheet1").Rows(y))
    End If
    'Range("B" & i) = WorksheetFunction.SumIf(Worksheets("Sheet1").Range(Name), Value, Worksheets("Sheet1").Range(Jan))
Next i
End Sub
 
Цитата
МатросНаЗебре написал:
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integernr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).RowName = "A:A"
Jan = "B:B"
Dim y As LongFor i = 2 To nr
   Value = Worksheets("Sheet2").Range("A" & i)
   y = 0
   On Error Resume Next
       y = WorksheetFunction.Match(Value, Worksheets("Sheet1").Range(Name), 0)
   On Error GoTo 0
   If y = 0 Then
       Range("B" & i) = 0
   Else
       Range("B" & i) = WorksheetFunction.Sum(Worksheets("Sheet1").Rows(y))
   End If
   'Range("B" & i) = WorksheetFunction.SumIf(Worksheets("Sheet1").Range(Name), Value, Worksheets("Sheet1").Range(Jan))
Next i
End Sub
Не работает...
Изменено: astranet - 17 Янв 2020 15:38:55
 
Ну прям сразу не работает.
Код
Sub Test()
Dim Value, Name, Jan, i As Integer, nr As Integer

nr = Worksheets("Sheet2").Cells.SpecialCells(xlLastCell).RowName = "A:A"
Jan = "B:B"
Dim y As Variant
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim a As VariantWith Worksheets("Sheet1")
    a = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
End WithFor y = 2 To UBound(a, 1)
    If Not dic.Exists(a(y, 1)) Then Set dic.Item(a(y, 1)) = CreateObject("Scripting.Dictionary")
    dic.Item(a(y, 1)).Item(y) = y
Next
For i = 2 To nr
    Value = Worksheets("Sheet2").Range("A" & i)
    Range("B" & i) = 0
    If dic.Exists(Value) Then
        For Each y In dic.Item(Value).Keys
            Range("B" & i) = Range("B" & i) + WorksheetFunction.Sum(Worksheets("Sheet1").Rows(y))
        Next
    End If
Next i
End Sub
Изменено: МатросНаЗебре - 17 Янв 2020 16:14:32
 
astranet, еще вариант
Скрытый текст
 
astranet, знаете разницу между цитатой и бестолковым копированием? Вернитесь. приведите в порядок сообщение.
Страницы: 1
Читают тему (гостей: 1)
Наверх