Excel - verschieben Sie mehrere Datenzellen nach unten und fügen Sie Zeilen unter

Question

Ich habe ein Excel 2007 Blatt mit 1K Datensätze mit 10 + Spalten. Das Problem ist, dass eine Zelle mehrere Daten enthält, die ich nach unten in jede Zelle bewegen muss und zusammen damit, muss ich neue Zeilen einfügen, da das Herunterschieben der Daten den Rest der Zeilen und Überlappungen stört. Ist das ein VBA-Code oder ein Makroprozess, der das tut? Bitte Hilfe.

Hier ist das Excel-Blatt.

Category | Desciption  | Sizes  | Price 
------ | ------ 
car  | Car Description | 123 - M | $20 
           1245 - XL | $50 
           1243 - XXL| $55 
Car2  | Car2 Description | 123 - M | $20 
           1245 - XL | $50 
           1243 - XXL| $55 

Ich hoffe, es ist klar, was ich erreichen will. SIzes Spalte Daten sind auf einer Zelle und ich muss diese beim Einfügen von Zeilen nach unten verschieben, um den Rest der Daten nicht zu stören.

Vielen Dank. Haroon

Answer 1

können Sie versuchen, und passen (siehe Kommentare) diesen Code:

Option Explicit 

Sub main() 
    Dim iRow As Long, nRows As Long, nData As Long 
    Dim arr As Variant 

    With Worksheets("data").Columns("C") '<--| assuming "Sizes" are in column "C" 
     nRows = .Cells(.Rows.Count, 1).End(xlUp).row '<--| get column "C" last non empty row 
     For iRow = nRows To 2 Step -1 '<--| loop through column "C" rows from the last one upwards 
      With .Cells(iRow) '<--| reference column "C" current cell 
       arr = Split(.Value, vbLf) '<--| try and split cell content into an array with "linefeed" character as delimeter 
       nData = UBound(arr) + 1 '<--| count array items (Split generates 0-based array, so a 1-element array upperbound is 0) 
       If nData > 1 Then '<--| if there are more than 1 ... 
        .EntireRow.Offset(1).Resize(nData - 1).Insert '<--| insert rows beneath current cell 
        .Resize(nData).Value = Application.Transpose(arr) '<--| fill current cell and new ones beneath it with array values (you have to transpose it, since array is a 1-row array while you're writing into a 1-column range) 
        .Offset(, 1).Resize(nData).Value = Application.Transpose(Split(.Offset(, 1).Value, vbLf)) '<--| do the same filling with adjacent cell 
       End If 
      End With 
     Next iRow 
    End With 
End Sub