Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Разделить сводные данные на отдельные строки
 
#1
20.01.2021 11:13:17
Добрый день, не могу придумать, как штатно решить такую задачу.

Есть таблица вида:

Клиент - Товар - Количество
Клиент1 - Товар1 - 2
Клиент2 - Товар2 - 4

Нужно сделать из этих данных наклейки на каждую единицу товара с наименованием клиента и товара на каждой наклейке. То есть всего 6 наклеек.

То есть получить из таблицы выше таблицу вида:
Клиент1 - Товар1
Клиент1 - Товар1
Клиент2 - Товар2
Клиент2 - Товар2
Клеинт2 - Товар2
Клиент2 - Товар2

На каждой строке отдельная единица товара.
Буду признателен за советы.
 
 
 
#2
20.01.2021 11:23:29
Юрий Хилов,типа такого. Удачного Вам применения на Вашем примере
Код
Sub mrshkei()
Dim i As Long, arr, arr2, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A1:B" & lr)
x = 0: j = 1
ReDim arr2(1 To Application.WorksheetFunction.Sum(Range("B1:B" & lr)), 1 To 1)
For i = LBound(arr) To UBound(arr)
    For n = 1 To arr(i, 2)
        arr2(j, 1) = arr(i, 1)
        j = j + 1
    Next n
Next i
Range("C1").Resize(UBound(arr2), 1) = arr2
End Sub
Изменено: Mershik - 20.01.2021 11:32:24
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
20.01.2021 12:04:17
Mershik, спасибо. Вот файл с примером. Помогите, пожалуйста, ваш скрипт применить? Я вообще в макросах не бум бум.
 
 
 
#4
20.01.2021 12:22:10
Юрий Хилов,
Код
Sub mrshkei()
Dim i As Long, arr, arr2, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A3:D" & lr)
x = 0: j = 1
ReDim arr2(1 To Application.WorksheetFunction.Sum(Range("D1:D" & lr)), 1 To 2)
For i = LBound(arr) To UBound(arr)
    For n = 1 To arr(i, 4)
        arr2(j, 1) = arr(i, 1)
        arr2(j, 2) = arr(i, 2)
        j = j + 1
    Next n
Next i
Range("H3").Resize(UBound(arr2), 2) = arr2
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
Страницы: 1
Наверх