Здравствуйте, уважаемые форумчане. Задача у меня с хитрецой. Нашел на форуме один вариант, но он лишь отчасти закрывает потребность. Поэтому прошу вашей помощи.
Есть табличка, в которой сумма распределена по номиналам подарочных карт. Нужно, чтобы макрос просматривал ячейки слева направо, сверху вниз и в случае нахождения значения больше "1" И/ИЛИ если в строке больше одной ячейки со значением больше 1, то создавалась строка снизу и в нее копировались некоторые данные, а само значение в ячейке выше уменьшалось на 1. И далее по циклу.
По итогу должно получиться таблица, в которой нет ни одного значения больше 1 и чтобы в строке не было больше одного значения больше нуля. Если у кого-то есть идеи как это можно реализовать, то буду безмерно благодарен.
Пожалуйста, давайте обойдемся без пассивно-агрессивной манеры общения.
, вы наверное ошиблись - это модератор он скорее всего безэмоциаонально Вам ответил так как следит за порядком на форуме ТЕМА: Создание строк в зависимости от количества указанного в строке
Код
Sub mrshkei()
Dim i As Long, j As Long, lr As Long, cell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:G" & lr): col = UBound(arr, 2) - LBound(arr) + 1
x = Application.WorksheetFunction.SumIf(Range("A2:G" & lr).Offset(1, 1), ">0", Range("A2:G" & lr).Offset(1, 1)) + 1
ReDim arr2(1 To x, 1 To col): k = 2
For i = 1 To col: arr2(k - 1, i) = arr(1, i): Next i
For i = LBound(arr) + 1 To UBound(arr)
For j = 2 To col
If arr(i, j) > 0 Then
For jj = 1 To arr(i, j)
arr2(k, 1) = arr(i, 1)
For n = 2 To col
If n <> j Then
arr2(k, n) = 0
Else
arr2(k, n) = 1
End If
Next n
k = k + 1
Next jj
End If
Next j
Next i
Range("S2").Resize(UBound(arr2), col) = arr2
End Sub
Mershik,отлично. Работает как часы. Спасибо огромное! Если вас не затруднит, могли бы вы расписать за что отвечают строки в макросе. Мне для личного развития.