Excel宏-如何根据特定的单元格值复制/拆分行

Question

I'm dealing with a huge spreadsheet and needed some help with a particular Macro I want to write for it.

I have a whole bunch of information pertaining to what equipment goes in which room. Each room has its own row for the type of equipment being installed. Sometimes one room has more than one of the same equipment and is specified in the quantity column. I need to split/copy such rows so that each equipment has its own row.

What I have currently:

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

What I need the macro to do for me: Find and copy all the rows with quantity greater than 1 into the following rows below the same number times as the quantity value and replace it all with quantity of 1 for the whole spreadsheet.

 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     

Thank you in advance.

Answer 1

To expand the rows in place, thae attached macro will follow this pattern:

• Loop thru your data, starting at the last row
• If Quantity > 1,
• Insert rows to make space
• copy row data down
• set Quantity to 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