Макрос Excel - Как скопировать / разбить строку на основе определенного значения ячейки

Question

Я имею дело с огромной электронной таблицей и мне нужна помощь с конкретным макросом, который я хочу написать для него.

У меня есть целая куча информации, касающейся того, какое оборудование идет в какую комнату. Каждая комната имеет свой ряд для типа устанавливаемого оборудования. Иногда одна комната имеет более одного оборудования и указывается в столбце количества. Мне нужно разделить / скопировать такие строки, чтобы у каждого оборудования был свой ряд.

Что у меня сейчас:

 A              B            C
 Equip. Name    Rm Number    Quantity
 xxxxx          1.2.3.4      5
 yyyyy          1.2.3.4      1

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

 A              B            C
 Equip. Name    Rm Number    Quantity
 xxxxx          1.2.3.4      1
 xxxxx          1.2.3.4      1
 xxxxx          1.2.3.4      1
 xxxxx          1.2.3.4      1
 xxxxx          1.2.3.4      1
 yyyyy          1.2.3.4      1     

Заранее спасибо.

Answer 1

Чтобы развернуть строки на месте, прикрепленный макрос будет следовать следующему шаблону:

• Цикл по вашим данным, начиная с последней строки
• Если количество> 1,
• Вставьте строки, чтобы освободить место
• скопируйте данные строки вниз
• установите количество в 1

.

Sub ExpandRows()
    Dim dat As Variant
    Dim i As Long
    Dim rw As Range
    Dim rng As Range

    Set rng = ActiveSheet.UsedRange
    dat = rng

    ' Loop thru your data, starting at the last row 
    For i = UBound(dat, 1) To 2 Step -1
        ' If Quantity > 1
        If dat(i, 3) > 1 Then
            ' Insert rows to make space
            Set rw = rng.Rows(i).EntireRow
            rw.Offset(1, 0).Resize(dat(i, 3) - 1).Insert
            ' copy row data down
            rw.Copy rw.Offset(1, 0).Resize(dat(i, 3) - 1)
            ' set Quantity to 1
            rw.Cells(1, 3).Resize(dat(i, 3), 1) = 1
        End If
    Next
End Sub