 |
 |
🧩 데이터 범위를 일정 행과 열로 나누기
- 실무에서 데이터 범위를 출력양식에 맞추어 일정한 행과 열로 분할 정리하는 경우가 많습니다. 그럴때 유용하게 사용할 수 있는 코드 입니다.
예) 출고/입고 데이터, 생산실적, 판매기록 등, 20행 x 3열
| Sub CopyData_ByUserColumnSplit() Dim ws As Worksheet Dim dataRange As Range Dim headerRange As Range Dim chunkSize As Long Dim splitColumnCount As Long Dim actualDataColumnCount As Long Dim destStartCell As Range Dim destCols() As Long Dim destRows() As Long Dim currentRow As Long Dim totalDataRows As Long Dim colIndex As Long Dim copyRange As Range Dim i As Long Set ws = ActiveSheet ' 활성화된 워크시트를 사용 ' ===== ① 데이터 범위 선택 ===== On Error Resume Next Set dataRange = Application.InputBox("① 데이터 범위를 마우스로 선택하세요 (헤더 포함)", "데이터 선택", Type:=8) On Error GoTo 0 If dataRange Is Nothing Then MsgBox "데이터 범위가 선택되지 않았습니다.", vbExclamation Exit Sub End If ' 데이터의 실제 열 수 파악 (예: A~C면 3) actualDataColumnCount = dataRange.Columns.Count ' ===== ② 덩어리 크기 입력 ===== chunkSize = CLng(InputBox("② 몇 행씩 끊어서 붙여넣을까요? (예: 20)", "덩어리 크기")) If Not IsNumeric(chunkSize) Then MsgBox "숫자를 입력하세요.", vbExclamation Exit Sub End If ' ===== ③ 몇 열로 나눌지 입력 ===== splitColumnCount = CLng(InputBox("③ 데이터를 몇 열로 나누어 붙여넣을까요? (예: 3)", "열 수")) If splitColumnCount < 1 Then MsgBox "1 이상의 값을 입력해주세요.", vbExclamation Exit Sub End If ' ===== ④ 시작 셀 선택 ===== Set destStartCell = Application.InputBox("④ 붙여넣기를 시작할 셀을 마우스로 클릭하세요", "시작 셀", Type:=8) If destStartCell Is Nothing Then MsgBox "시작 셀이 선택되지 않았습니다.", vbExclamation Exit Sub End If ' ===== 열과 행 위치 배열 설정 ===== ReDim destCols(1 To splitColumnCount) ' 각 열의 시작 열 주소 저장 ReDim destRows(1 To splitColumnCount) ' 각 열의 현재 행 위치 저장 For i = 1 To splitColumnCount destCols(i) = destStartCell.Column + (i - 1) * actualDataColumnCount ' 열 간격은 데이터 열 수만큼 띄움 destRows(i) = destStartCell.Row ' 처음 시작 행 위치 설정 (헤더 포함) Next i ' 헤더 범위 저장 Set headerRange = dataRange.Rows(1) totalDataRows = dataRange.Rows.Count currentRow = 2 ' 실제 데이터는 두 번째 줄부터 시작 (헤더 제외) ' ===== 복사 반복 루프 ===== Do While currentRow <= totalDataRows For colIndex = 1 To splitColumnCount If currentRow > totalDataRows Then Exit Do Dim chunkEndRow As Long chunkEndRow = WorksheetFunction.Min(currentRow + chunkSize - 1, totalDataRows) ' 헤더 붙여넣기 headerRange.Copy Destination:=ws.Cells(destRows(colIndex), destCols(colIndex)) destRows(colIndex) = destRows(colIndex) + 1 ' 데이터 붙이기 전 한 줄 내림 ' 데이터 덩어리 복사 Set copyRange = dataRange.Range("A" & currentRow).Resize(chunkEndRow - currentRow + 1, actualDataColumnCount) copyRange.Copy Destination:=ws.Cells(destRows(colIndex), destCols(colIndex)) ' 다음 데이터가 들어갈 행 위치 설정 destRows(colIndex) = destRows(colIndex) + chunkSize currentRow = currentRow + chunkSize ' 다음 덩어리 시작 위치로 이동 Next colIndex Loop ' 결과 메시지 출력 MsgBox totalDataRows - 1 & " 데이터를 " & splitColumnCount & "개의 열에 나누어 복사했습니다!", vbInformation End Sub |