| |
'------------------------------------------------
Sub separate()
'------------------------------------------------
Dim rngX As Range
Dim v As Variant
Set rngX = Range("A1")
' 전체 자료 담을 변수
Dim rows As Variant: rows = Array()
' 한 행 담을 변수
Dim row As Variant
' 머지 여부를 담을 변수
Dim tfmerge As Boolean
' A열이 빈셀이 아닐 때까지 돌고
'-------------------------------
Do Until rngX.Value = ""
'-------------------------------
' 행 자료 담을 변수 초기화
row = Array()
'상품 담고
row = push(row, rngX.Value)
' 머지 여부 확인
If rngX.MergeCells Then tfmerge = True Else tfmerge = False
'다음 열 담고
row = push(row, rngX.Offset(0, 1).Value)
' 금액 담고
row = push(row, rngX.Offset(0, 2).Value)
' 종류 담고
row = push(row, rngX.Offset(0, 3).Value)
' 여러 줄 담기
If tfmerge Then ' 머지된 자료 라면
' 여러 줄의 자료를 배열로 받아내고
v = rngX.Offset(0, 4).Resize(rngX.MergeArea.Count, 1).Value
' 2차원 배열을 1차원 배열로 바꾼 후
' 그 사이 개행문자를 조인
v = Join(Application.Transpose(v), Chr(10))
' 변수에 담고
row = push(row, v)
Else ' 머지 아닌 자료
row = push(row, rngX.Offset(0, 4).Value)
End If
'Debug.Print Join(row, ", ")
' 행 자료를 전제 변수에 담고
rows = push(rows, row)
' 다음 줄로 옮기고
Set rngX = rngX.Offset(1)
'-------------------------------
Loop
'-------------------------------
' 1차원 배열을 2차원 배열로 변환
rows = Application.Transpose(Application.Transpose(rows))
' 시트에 붙여 넣기
With Sheet2.Range("A1")
.CurrentRegion.ClearContents
.Resize(UBound(rows, 1), UBound(rows, 2)).Value = rows
End With
End Sub
'-------------------------------------------------------------
Function push(col As Variant, ele As Variant) As Variant
'-------------------------------------------------------------
Dim i As Long: i = UBound(col, 1) + 1
ReDim Preserve col(i)
col(i) = ele
push = col
End Function
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
