[엑셀 실무]특정 구분자로 셀을 분리하여 여러 행으로 복사 (split cell to Rows)

-------------------------------------------------------------------------------- 좋아요/구독 눌러주세요 큰 힘이 됩니다 -------------------------------------------------------------------------------- 질문 사항이 있으시면 kim5953@gmail com으로 해 주세요 Option Explicit '---------------------------------------- Sub split_row_special() '---------------------------------------- Dim rngX As Range: Set rngX = Range("H2:M5") Dim r As Long Dim myJob As String, myHost As String, myIp As String, _ yourJob As String, yourHost As String, yourIP As String Dim vMyhost As Variant, vMyip As Variant, _ vYourhost As Variant, vYourip As Variant Dim row As Range Dim iMyHost As Long Dim iYourHost As Long Dim colX As Collection: Set colX = New Collection '-------------------------------- For Each row In rngX Rows '-------------------------------- myJob = Trim(row Cells(1) Value): myHost = Trim(row Cells(2) Value) myIp = Trim(row Cells(3) Value): yourJob = Trim(row Cells(4) Value) yourHost = Trim(row Cells(5) Value): yourIP = Trim(row Cells(6) Value) vMyhost = Split(myHost, "," & Chr(10)) vMyip = Split(myIp, "," & Chr(10)) vYourhost = Split(yourHost, "," & Chr(10)) vYourip = Split(yourIP, "," & Chr(10)) '------------------------------------------------- For iMyHost = LBound(vMyhost) To UBound(vMyhost) '------------------------------------------------- '------------------------------------------------- For iYourHost = LBound(vYourhost) To UBound(vYourhost) '------------------------------------------------- colX Add Array(myJob, vMyhost(iMyHost), vMyip(iMyHost), yourJob, vYourhost(iYourHost), vYourip(iYourHost)) '------------------------------------------------- Next iYourHost '------------------------------------------------- Next iMyHost Next row '------------------------------------- '데이타 시트에 뿌리기 '------------------------------------- '시작셀 Dim rngY As Range: Set rngY = Range("A15") Dim item As Variant Dim iSize As Long: iSize = UBound(colX item(1), 1) + 1 For Each item In colX rngY Resize(1, iSize) Value = item Set rngY = rngY Offset(1) Next item End Sub #split rows #Collection #Array