Excel VBA разделение строк

Question

Если в ячейке таблицы данных содержится значение x> 1, я хотел бы скопировать и вставить строку, содержащую эту ячейку «x», количество раз. Строки будут вставляться с x = 1 в следующей доступной пустой строке.

---

TREVDAN 2 CENTRAL 3 GAL FAB 1 Из этого.

---

TREVDAN 1 TREVDAN 1 CENTRAL 1 CENTRAL 1 CENTRAL 1 GAL FAB 1 Чтобы выглядеть примерно так.

Answer 1

Это будет работать на вас.

Sub SpecialCopy() 
    'Assuming A and B columns source columns 
    Dim i As Long, k As Long 
    Dim j As Long: j = 1 
    For i = 1 To Cells(Cells.Rows.Count, 1).End(xlUp).Row 
     k = 1 
     Do While k <= Range("B" & i).Value 
      'Assuming C and D are destination columns 
      Range("C" & j).Value = Range("A" & i).Value 
      Range("D" & j).Value = 1 
      j = j + 1 
      k = k + 1 
     Loop 
    Next i 
End Sub 

Answer 2

здание от ответа, предоставленной @Jeanno, вы можете использовать следующее, если вы хотите, чтобы вставить результаты непосредственно поверх исходной таблицы:

Sub SpecialCopy() 

'Assuming A and B columns source columns 
Dim i As Long, k As Long 
Dim j As Long: j = 1 
Dim ArrayLength As Long: ArrayLength = Application.WorksheetFunction.Sum(ActiveSheet.Range("B:B")) 
ReDim MyArray(1 To ArrayLength) As String 

For i = 1 To Cells(Cells.Rows.Count, 1).End(xlUp).Row 
    k = 1 
    Do While k <= Range("B" & i).Value 
     MyArray(j) = Range("A" & i).Value 
     j = j + 1 
     k = k + 1 
    Loop 
Next i 

For Each MyCell In Range("a1:a" & ArrayLength) 
MyCell.Value = MyArray(MyCell.Row()) 
MyCell.Offset(0, 1).Value = 1 
Next MyCell 

End Sub