Здравствуйте! Подскажите, пожалуйста, в следующем. Есть таблица продуктовой корзины. Необходимо, чтобы после заполнения пользователем нужных ему строк этой таблицы (цена, кол-во позиций) на другом листе выводилась эта же таблица, но уже за исключением тех продуктов, которые не были затронуты, т. е. которые не нужно покупать. В идеале должен получится результат, который показан на листе 'Итоговый список', с учетом отмеченных (посчитанных) позиций листа 'Продуктовая корзина'.
Здравствуйте! Подскажите, пожалуйста, в следующем. Есть таблица продуктовой корзины. Необходимо, чтобы после заполнения пользователем нужных ему строк этой таблицы (цена, кол-во позиций) на другом листе выводилась эта же таблица, но уже за исключением тех продуктов, которые не были затронуты, т. е. которые не нужно покупать. В идеале должен получится результат, который показан на листе 'Итоговый список', с учетом отмеченных (посчитанных) позиций листа 'Продуктовая корзина'.Aleksanqr
Sub tt() Dim sh As Worksheet Application.ScreenUpdating = 0 Me.Copy after:=Sheets(Me.Index) Set sh = ActiveSheet With sh .Name = "Итог_" & Format(Now, "YYYY_MM_DD hh_mm_ss") nc_ = 4 For i = 1 To 2 c_ = 1 + (i - 1) * 4 r1_ = Cells(Rows.Count, c_).End(3).Row For j = r1_ To 1 Step -1 If Cells(j, c_ + 1) = "" And Cells(j, c_) <> "" Then If Cells(j, c_).MergeCells = False Then .Cells(j, c_).Resize(1, nc_).Delete Shift:=xlUp Else If .Cells(j + 2, c_ + 1) = "" Then .Cells(j, c_).Resize(2, nc_).Delete Shift:=xlUp End If End If End If Next j Next i End With Application.ScreenUpdating = 1 End Sub
[/vba]
Вариант кнопочкой [vba]
Код
Sub tt() Dim sh As Worksheet Application.ScreenUpdating = 0 Me.Copy after:=Sheets(Me.Index) Set sh = ActiveSheet With sh .Name = "Итог_" & Format(Now, "YYYY_MM_DD hh_mm_ss") nc_ = 4 For i = 1 To 2 c_ = 1 + (i - 1) * 4 r1_ = Cells(Rows.Count, c_).End(3).Row For j = r1_ To 1 Step -1 If Cells(j, c_ + 1) = "" And Cells(j, c_) <> "" Then If Cells(j, c_).MergeCells = False Then .Cells(j, c_).Resize(1, nc_).Delete Shift:=xlUp Else If .Cells(j + 2, c_ + 1) = "" Then .Cells(j, c_).Resize(2, nc_).Delete Shift:=xlUp End If End If End If Next j Next i End With Application.ScreenUpdating = 1 End Sub
_Boroda_, а на листе с результатами кнопка, видимо, ошибочно затесалась? Наберусь наглости и попрошу помочь с еще одной кнопкой, которая будет обнулять лист 'Продуктовая корзина' (удалять значения ячеек кол-во), чтобы каждый раз, как с чистого листа, так сказать. Если, конечно же, не затруднит!
_Boroda_, а на листе с результатами кнопка, видимо, ошибочно затесалась? Наберусь наглости и попрошу помочь с еще одной кнопкой, которая будет обнулять лист 'Продуктовая корзина' (удалять значения ячеек кол-во), чтобы каждый раз, как с чистого листа, так сказать. Если, конечно же, не затруднит!Aleksanqr
Сообщение отредактировал Aleksanqr - Среда, 13.06.2018, 20:01
Периодически пользователь будет пытаться что-то добавить или убрать уже из сформированного списка. И если список большой, то будет не совсем удобно из-за 3-4х позиций снова забивать еще 30, например. Кнопка с очищением старого наполнения решает эту проблему.
Еще пара моментов. Я поменял столбцы "Цена" и "Кол-во" местами. Было бы здорово, если бы после клика по кнопке очищался только первый столбец "Кол-во".
Второй момент - в сформированном списке можно ли убрать столбцы "Кол-во", "Цена", "Итого", если продуктов из этой половины листа нет?
[img][/img]
А так же смещать список (Бакалея, соусы, ...) к левому краю, при отсутствии продуктов из списков "Мясо и рыба", "Фрукты и овощи", ... .
Периодически пользователь будет пытаться что-то добавить или убрать уже из сформированного списка. И если список большой, то будет не совсем удобно из-за 3-4х позиций снова забивать еще 30, например. Кнопка с очищением старого наполнения решает эту проблему.
Еще пара моментов. Я поменял столбцы "Цена" и "Кол-во" местами. Было бы здорово, если бы после клика по кнопке очищался только первый столбец "Кол-во".
Второй момент - в сформированном списке можно ли убрать столбцы "Кол-во", "Цена", "Итого", если продуктов из этой половины листа нет?
[img][/img]
А так же смещать список (Бакалея, соусы, ...) к левому краю, при отсутствии продуктов из списков "Мясо и рыба", "Фрукты и овощи", ... .Aleksanqr
Aleksanqr, так нужно? Подправил немного файл и первый макрос. И макрос удаления там ниже еще
[vba]
Код
Sub Itog() Dim sh As Worksheet, sh0 As Worksheet Application.ScreenUpdating = 0 Set sh0 = ActiveSheet With sh0 .Copy after:=Sheets(.Index) End With Set sh = ActiveSheet With sh .Name = "Итог_" & Format(Now, "YYYY_MM_DD hh_mm_ss") nc_ = 4 For i = 1 To 2 c_ = 1 + (i - 1) * 4 r1_ = .Cells(.Rows.Count, c_).End(3).Row ' sh0.Cells(2, c_ + 1).Resize(r1_, nc_ - 2).ClearContents For j = r1_ To 1 Step -1 If .Cells(j, c_ + 2) = "" And .Cells(j, c_) <> "" Then If .Cells(j, c_).MergeCells Then If .Cells(j + 2, c_ + 2) = "" Then .Cells(j, c_).Offset(-1).Resize(3, nc_).Delete Shift:=xlUp End If Else .Cells(j, c_).Resize(1, nc_).Delete Shift:=xlUp End If End If Next j Next i .DrawingObjects.Delete For i = 2 To 1 Step -1 c_ = 3 + (i - 1) * 4 If .Cells(4, c_) = "" Then .Cells(1, c_ - 2).Resize(, 4).EntireColumn.Delete nd_ = nd_ + 1 End If Next i If nd_ = 2 Then Application.DisplayAlerts = 0 .Delete Application.DisplayAlerts = 1 MsgBox "Вы ничего не выбрали" sh0.Select End If End With Application.ScreenUpdating = 1 End Sub
Sub Udal() Application.ScreenUpdating = 0 nc_ = 4 For i = 1 To 2 c_ = 3 + (i - 1) * 4 r1_ = Cells(Rows.Count, c_).End(3).Row Cells(2, c_).Resize(r1_).ClearContents Next i Application.ScreenUpdating = 1 End Sub
[/vba]
Aleksanqr, так нужно? Подправил немного файл и первый макрос. И макрос удаления там ниже еще
[vba]
Код
Sub Itog() Dim sh As Worksheet, sh0 As Worksheet Application.ScreenUpdating = 0 Set sh0 = ActiveSheet With sh0 .Copy after:=Sheets(.Index) End With Set sh = ActiveSheet With sh .Name = "Итог_" & Format(Now, "YYYY_MM_DD hh_mm_ss") nc_ = 4 For i = 1 To 2 c_ = 1 + (i - 1) * 4 r1_ = .Cells(.Rows.Count, c_).End(3).Row ' sh0.Cells(2, c_ + 1).Resize(r1_, nc_ - 2).ClearContents For j = r1_ To 1 Step -1 If .Cells(j, c_ + 2) = "" And .Cells(j, c_) <> "" Then If .Cells(j, c_).MergeCells Then If .Cells(j + 2, c_ + 2) = "" Then .Cells(j, c_).Offset(-1).Resize(3, nc_).Delete Shift:=xlUp End If Else .Cells(j, c_).Resize(1, nc_).Delete Shift:=xlUp End If End If Next j Next i .DrawingObjects.Delete For i = 2 To 1 Step -1 c_ = 3 + (i - 1) * 4 If .Cells(4, c_) = "" Then .Cells(1, c_ - 2).Resize(, 4).EntireColumn.Delete nd_ = nd_ + 1 End If Next i If nd_ = 2 Then Application.DisplayAlerts = 0 .Delete Application.DisplayAlerts = 1 MsgBox "Вы ничего не выбрали" sh0.Select End If End With Application.ScreenUpdating = 1 End Sub
Sub Udal() Application.ScreenUpdating = 0 nc_ = 4 For i = 1 To 2 c_ = 3 + (i - 1) * 4 r1_ = Cells(Rows.Count, c_).End(3).Row Cells(2, c_).Resize(r1_).ClearContents Next i Application.ScreenUpdating = 1 End Sub
Нашел баг, который заключается в удалении шапки "Кол-во", "Цена", "Итого", если в итоговом списке отсутствуют продукты из первых категорий "Мясо и рыба" и "Бакалея".
Пытался решить проблему самостоятельно, но низкий уровень VBA дает о себе знать. Прошу помочь исправить.
Поздно спохватился, что не хватает резюмирующей ячейки "Итого", которая выводит общую стоимость всей покупки. Добавил. Ее бы тоже как-нибудь корректно пристроить в итоговый лист.
Еще вопрос - слишком ли проблематично осуществить смещение подобного плана:
Прикреплю немного подкорректированный файл.
Нашел баг, который заключается в удалении шапки "Кол-во", "Цена", "Итого", если в итоговом списке отсутствуют продукты из первых категорий "Мясо и рыба" и "Бакалея".
Пытался решить проблему самостоятельно, но низкий уровень VBA дает о себе знать. Прошу помочь исправить.
Поздно спохватился, что не хватает резюмирующей ячейки "Итого", которая выводит общую стоимость всей покупки. Добавил. Ее бы тоже как-нибудь корректно пристроить в итоговый лист.
Еще вопрос - слишком ли проблематично осуществить смещение подобного плана:
Прикреплю немного подкорректированный файл.Aleksanqr