나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 dew (dewdrop)

추천:  0
파일:     PC제조사_Ans.xlsm (22.9KB) 조회:  387
제목:   [RE]엑셀, 셀안에 데이터 분리하기
     
  감사합니다.
많은 도움되었습니다.
하나의 행이 아니라 여려 행인 경우 어떻게 해야할지 한번 더 부탁드립니다.
파일 첨부했습니다.
==============[길인영님 글에 대한 답변입니다]==============

첨부파일 참조하세요..

Sub UserSplit02()
    Dim rData As Range, rRow As Range, rTg As Range
    Dim iMax As Integer
    
    Dim vTempLf, vResult(), vTrans
    Dim iX As Integer, iY As Integer, iNo As Integer
    
    Set rTg = Range("N1")
    rTg.CurrentRegion.Clear
    
    Set rData = ActiveSheet.Range("A1").CurrentRegion
    
    For Each rRow In rData.Offset(1).Resize(rData.Rows.Count - 1).Rows
        iMax = getMaxUbound(rRow)
        
        For iX = 0 To iMax
            iNo = iNo + 1
            ReDim Preserve vResult(1 To 3, 1 To iNo)    ' 임시결과값 저장하기 위한 변수
        
            For iY = 1 To rRow.Columns.Count
                vTempLf = Split(rRow.Cells(1, iY), vbLf)
                
                If iX <= UBound(vTempLf) Then
                    vResult(iY, iNo) = vTempLf(iX)
                Else
                    vResult(iY, iNo) = vResult(iY, iNo - 1)
                End If
            Next
        Next
    Next
    
    vTrans = WorksheetFunction.Transpose(vResult)           ' 행열 전환
    rData.Rows(1).Copy rTg
    rTg.Offset(1).Resize(UBound(vTrans, 1), UBound(vTrans, 2)) = vTrans
    
    With rTg.CurrentRegion.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 48
        .Weight = xlThin
    End With
End Sub

Function getMaxUbound(rRow As Range)
    Dim rX As Range
    Dim iMax As Integer, iX As Integer
    
    For Each rX In rRow.Cells
        iX = UBound(Split(rX, vbLf))
        If iMax < iX Then iMax = iX
    Next
    getMaxUbound = iMax
End Function
 
[불량 게시물 신고]  
        
  

작성일 : 2019-04-16(13:58)
최종수정일 : 2019-04-16(13:58)
 


 ◎ 관련글

  제 목   작성자   날짜
엑셀, 셀안에 데이터 분리하기 길인영 2019-04-15
[RE]엑셀, 셀안에 데이터 분리하기 dew 2019-04-16
[RE]엑셀, 셀안에 데이터 분리하기 길인영 2019-04-16
[RE]엑셀, 셀안에 데이터 분리하기 dew 2019-04-16
[RE]엑셀, 셀안에 데이터 분리하기 참서리 2019-04-16