Страницы: 1
RSS
Создание строк в зависимости от количества указанного в строке
 
Здравствуйте, уважаемые форумчане. Задача у меня с хитрецой. Нашел на форуме один вариант, но он лишь отчасти закрывает потребность. Поэтому прошу вашей помощи.

Есть табличка, в которой сумма распределена по номиналам подарочных карт. Нужно, чтобы макрос просматривал ячейки слева направо, сверху вниз и в случае нахождения значения больше "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 - 11.01.2022 22:38:47
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,отлично. Работает как часы. Спасибо огромное!
Если вас не затруднит, могли бы вы расписать за что отвечают строки в макросе. Мне для личного развития.

Еще раз спасибо!
Страницы: 1
Наверх