У меня есть таблица со списком медицинского оборудования (идентифицированного JSN) в комнате. Один элемент оборудования (JSN) может иметь несколько количеств в помещении. Я хотел бы разделить все строки с количеством больше 1 на несколько строк с одинаковыми данными, одновременно меняя количество на 1 советник. Вот пример того, как выглядит существующая электронная таблица (без других столбцов):

Nomenclature           JSN          Wayfinding Rm #        QTY         Installed
Shelving, Solid       M2090             40-179              3           5/5/15
Waste Can, Swing      F2010             11-087              2           9/9/15
Stand, Mayo, Screw    M8810             11-078              1           8/1/15

Вот что мне нужно, чтобы это выглядело так:

Nomenclature          JSN          Wayfinding Rm #         QTY       Installed
Shelving, Solid       M2090             40-179              1           5/5/15
Shelving, Solid       M2090             40-179              1           5/5/15
Shelving, Solid       M2090             40-179              1           5/5/15
Waste Can, Swing      F2010             11-087              1           9/9/15
Waste Can, Swing      F2010             11-087              1           9/9/15
Stand, Mayo, Screw    M8810             11-078              1           8/1/15

Любая помощь будет очень признателен. Обратите внимание, что я только что узнал о VBA и макросах СЕГОДНЯ! Пытаюсь выучить. Большое спасибо всем, кто может помочь этому борющемуся, но нетерпеливому новичку!

1 ответ1

1

Нечто подобное должно работать, предполагая, что эти данные начинаются в ячейке A1

На самом деле - здесь они будут оставаться в порядке

Sub test()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim howmany As Integer
For i = lastrow To 1 Step -1
    If Cells(i, 4) > 1 Then
       howmany = Cells(i, 4)
       For j = 1 To howmany - 1
       Rows(i + 1).Insert (xlShiftDown)
       Cells(i, 4) = 1
       Cells(i + 1, 1) = Cells(i, 1)
       Cells(i + 1, 2) = Cells(i, 2)
       Cells(i + 1, 3) = Cells(i, 3)
       Cells(i + 1, 4) = Cells(i, 4)
       Cells(i + 1, 5) = Cells(i, 5)
       Next
    End If
Next

End Sub

Этот ставит их в конце:

Sub test()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim nextrow As Integer
nextrow = lastrow + 1
Dim howmany As Integer
For i = 1 To lastrow
    If Cells(i, 4) > 1 Then
       howmany = Cells(i, 4)
       For j = 1 To howmany - 1
       Cells(i, 4) = 1
       Cells(nextrow, 1) = Cells(i, 1)
       Cells(nextrow, 2) = Cells(i, 2)
       Cells(nextrow, 3) = Cells(i, 3)
       Cells(nextrow, 4) = Cells(i, 4)
       Cells(nextrow, 5) = Cells(i, 5)
       nextrow = nextrow + 1
       Next
    End If
Next

End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .