А вы макрос запустили ? Я понял что вы имеете ввиду но в названии темы вы конкретно пишите « ми соединить в 1 список»
вот и добавляет в один список ...вы так и не показали каким должен быть результат, за вас изменили данные для корректной работы макроса И придумали результат, а теперь оказалось что не так )
что бы было вот это
Цитата |
---|
идеальный варинат - это чтоб еще учитывался остаток продуктов на складе - отнимать от необходимого к закупки. |
как и говорил выше - нужен пример и данные откуда брать и куда подставлять....
с учетом
Цитата |
---|
на вкладке "общая" - ингредиенты не просуммировались, а добавились ниже в список |
берите этот макрос (в замен выше приведенного)
Код |
---|
Sub ddsdd()
Dim i As Long, k As Long
Dim RowDel As Range, Radd As Range
Dim shRec As Worksheet, shO As Worksheet
Dim Meval As Range
Set shRec = Worksheets("Рецепты")
Set shO = Worksheets("общий")
Application.ScreenUpdating = False
Lr = shRec.Cells(Rows.Count, 1).End(xlUp).Row
shO.Range("A2:E10000").Clear
Set rng1 = shRec.Range("A1:A" & Lr)
Set rng2 = shRec.Range("B1:C" & Lr)
rng1.Copy
shO.Range("A2").PasteSpecial Paste:=xlPasteValues
rng2.Copy
shO.Range("D2").PasteSpecial Paste:=xlPasteValues
For i = 2 To shO.Cells(Rows.Count, 1).End(xlUp).Row
If shO.Cells(i, 5) = "" Then
shO.Cells(i, 5) = shO.Cells(i - 1, 5)
shO.Cells(i, 4) = shO.Cells(i, 4) * shO.Cells(i, 5)
End If
Next i
For Each RowDel In shO.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If RowDel.Offset(0, 3).Value = "" Or _
Application.WorksheetFunction.CountIf(shO.Range(shO.Cells(1, 1), shO.Cells(RowDel.Row, 1)), RowDel.Value) > 1 Then
Set Myval = shO.Range(shO.Cells(1, 1), shO.Cells(RowDel.Row, 1)).Find(RowDel)
shO.Cells(Myval.Row, 4) = shO.Cells(Myval.Row, 4) + shO.Cells(RowDel.Row, 4)
If Radd Is Nothing Then
Set Radd = RowDel
Else
Set Radd = Union(Radd, RowDel)
End If
End If
Next RowDel
If Not Radd Is Nothing Then Radd.EntireRow.Delete
shO.Columns(5).Clear
shO.Range("A2").Activate
Application.ScreenUpdating = True
End Sub
|