여러 데이터 셀을 Excel- 아래로 이동하고 아래에 행을 삽입하십시오.

Question

10 개 이상의 열이있는 1K 레코드가 포함 된 Excel 2007 시트가 있습니다. 문제는 하나의 셀에 각 셀로 이동해야하는 여러 데이터가 포함되어 있으며 데이터를 아래로 이동하면 나머지 행과 겹침이 중단되므로 새 행을 삽입해야한다는 것입니다. 그들의 VBA 코드 또는 매크로 프로세스가 그렇게합니다. 도와주세요.

여기 엑셀 시트가 있습니다.

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 

내가 원하는 것을 명확히하기를 바랍니다. SIZE 컬럼 데이터는 하나의 셀에 있고 아래의 나머지 데이터를 방해하지 않도록 행을 삽입하는 동안이 데이터를 이동해야합니다.

많은 감사. 하운

Answer 1

당신이 시도하고 (설명 참조)이 코드를 적용 할 수 있습니다 : 나는 그것을 실행할 때

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