Страницы: 1
RSS
Макрос для расчета промежуточного итога по группе товаров
 
Друзья! Помогите занести макросом формулы в ячейки выделенные в файле красным цветом.Навыков  в программировании, к сожалению нет. Прошу учесть, что кол-во позиций товара меняется. Т.е. макрос должен определять ячейки, колонки "Остаток", между группами товаров и заносить в окрашенную ячейку формулу с их суммой. В форуме рылся, но ничего похожего не нашел. Надоело вручную. Формулами могу, но проклятые педанты надоели со своими "задрочками". Спасибо заранее.
 
Jerry.Sweer,  Вариант цикл
Код
Sub DSD()
Dim I As Long
Dim k As Long
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 5).End(xlUp).Row
    For I = LR To 3 Step -1
        If Cells(I, 5) <> "" Then
            k = k + 1
        Else
            Cells(I, 8) = Application.WorksheetFunction.Sum(Range(Cells(I + 1, 8), Cells(I + k, 8)))
            Cells(I, 9) = Application.WorksheetFunction.Sum(Range(Cells(I + 1, 9), Cells(I + k, 9)))
            k = 0
        End If
    Next I
Application.ScreenUpdating = True
End Sub

вариант массивом

Код
Sub massiv()
Dim I As Long
Dim k As Long, k2 As Long
Dim arr()
arr = Range("A3:I" & Cells(Rows.Count, 5).End(xlUp).Row)
    For I = UBound(arr) To 1 Step -1
        If arr(I, 5) <> "" Then
            k = k + arr(I, 8)
            k2 = k2 + arr(I, 9)
        Else
            arr(I, 8) = k
            arr(I, 9) = k2
            k = 0
            k2 = 0
        End If
    Next I
Range("h3:h" & Cells(Rows.Count, 5).End(xlUp).Row) = Application.WorksheetFunction.Index(arr, 0, 8)
Range("i3:i" & Cells(Rows.Count, 5).End(xlUp).Row) = Application.WorksheetFunction.Index(arr, 0, 9)
End Sub

Изменено: Mershik - 24.05.2020 20:32:46
Не бойтесь совершенства. Вам его не достичь.
 
Здравствуйте!
Код
Sub qwe()
For x = 3 To Range("H" & Rows.Count).End(xlUp).Row
    If Range("G" & x) = "" Then
        Range("H" & x).ClearContents
        Range("I" & x).ClearContents
        For i = x + 1 To Range("H" & Rows.Count).End(xlUp).Row
            If Range("G" & i) = "" Then
                x = i - 1
                Exit For
            End If
            Range("H" & x) = Range("H" & x) + Range("H" & i)
            Range("I" & x) = Range("I" & x) + Range("I" & i)
        Next i
    End If
Next x
End Sub
 
Православное спасибо.
Страницы: 1
Наверх