Объединение столбцов и подсчет общего запаса - PullRequest
Новая
       4

Объединение столбцов и подсчет общего запаса

0 голосов
/ 18 февраля 2020

Это мой первый пост здесь, поэтому, пожалуйста, помогите мне исправить мой пост, если это необходимо. Я работаю с тестовым инвентарным листом, который должен рассчитать мой общий запас. Мне нужна помощь с моим 3-м For заявлением. Я бы хотел, чтобы он подсчитал, сколько древесины каждого сорта у меня под рукой. Например, я хотел бы, чтобы данные показали, что у меня есть 4 куска дуба, 3 красных дерева, 15 вишен и 11 берез. В настоящее время код просто добавляет столбец QTY. 

Sub Consolidate()
    Dim R As Range, c As Range
    Set R = Range("A1:E" & Cells(Rows.Count, "D").End(xlUp).Row)

    Application.ScreenUpdating = False

    Columns("G:K").ClearContents
    R.Columns(4).AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("J1"), Unique:=True
    Range("G1").Resize(1, 5).Value = Range("A1:E1").Value

    For Each c In Range("G2:G" & Cells(Rows.Count, "J").End(xlUp).Row)
        c.Value = c.Row - 1
    Next c

    Range("H2:H" & Cells(Rows.Count, "J").End(xlUp).Row).Value = 1

    For Each c In Range("I2:I" & Cells(Rows.Count, "J").End(xlUp).Row)
        c.Value = Evaluate("INDEX(" & R.Columns(3).Address & ",MATCH(" & c.Offset(0, _
        1).Address & "," & R.Columns(4).Address & ",0))")
    Next c

    For Each c In Range("K2:K" & Cells(Rows.Count, "J").End(xlUp).Row)
        c.Value = Evaluate("SUMPRODUCT(--(" & R.Columns(4).Address & "=" & _
        c.Offset(0, -1).Address & ")," & R.Columns(2).Address & "," & _
        R.Columns(5).Address & ")")
        c.Value = c.Value
    Next c

    For Each c In Range("H2:H" & Cells(Rows.Count, "J").End(xlUp).Row)
        c.Value = Evaluate("SUM(--(" & R.Columns(4).Address & "=" & _
        c.Offset(0, -1).Address & ")," & R.Columns(2).Address & "," & ")")
        c.Value = c.Value
    Next c

    Application.ScreenUpdating = True

End Sub

До VBA

После VBA

...