excel - 단일 열의 데이터를 여러 열의 열 단위 vba로 분할

조금 사용자 친화적 인이 코드를 사용해보십시오

이 매크로를 실행할 때 vba  데이터를 분할하려는 열 수를 입력 할 수있는 텍스트 상자를 표시합니다.

5 를 입력하면 을 클릭하고 Ok 를 클릭하십시오. ,

여기에 코드가 있습니다

Sub transpose()
Dim col As Variant, i As Long, j As Long, k As Long
col = InputBox("Enter number of columns")
col = Cells(Rows.Count, 1).End(xlUp).Row / col
col = WorksheetFunction.RoundUp(col, 0)
j = 1
k = 3
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Cells(j, k) = Cells(i, 1)
    j = j + 1
    If j > col Then
        j = 1
        k = k + 1
    End If
Next i
End Sub

이 코드는 입력을 기반으로 열을 동적으로 분할합니다. 이것이 도움이 되길 바랍니다.

이와 같은 일이 아직 완전히 테스트되지는 않았지만 시작입니다.

Sub t()
Dim xDimension As Integer
Dim lngLoopCount As Long
Dim lngLastRow As Long
Dim lngPresentation As Long
xDimension = 5
lngPresentation = 1
lngLastRow = Range("a1").End(xlDown).Row
For lngLoopCount = 1 To lngLastRow Step xDimension
    Range("c1").Offset(lngPresentation, 0).Resize(1, xDimension).Value = _
                Application.Transpose(Range("a1").Offset(lngLoopCount - 1, 0).Resize(xDimension, 1).Value)
    lngPresentation = lngPresentation + 1
Next
End Sub

원하는 순서대로 범위를 5 열로 나눕니다. With 를 업데이트해야합니다.  당신이보고있는 관련 시트에 진술하고 NoCols 를 변경하여 분할을 변경할 수 있습니다  출력에서 원하는 열 수로 변경할 수 있습니다.

Public Sub SplitRange()
    Dim arr As Variant, tmp As Variant
    Dim i As Long, j As Long
    Dim NoCols As Long
    Dim rng As Range
    Dim c
    ' Change this to how many columns you want
    NoCols = 5
    ' Change to your sheet
    With Sheet6
        .Range(.Columns(4), .Columns(20)).Clear
        Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
        tmp = rng.Value2
        ReDim arr(1 To WorksheetFunction.RoundUp(UBound(tmp) / NoCols, 0), 1 To NoCols)
        i = 1: j = 1
        For Each c In tmp
            If i > WorksheetFunction.RoundUp(UBound(tmp) / NoCols, 0) Then j = j + 1: i = 1
                arr(i, j) = c
            i = i + 1
        Next c
        With .Cells(1, 4)
            Range(.Offset(0, 0), .Offset(UBound(arr, 1) - 1, UBound(arr, 2) - 1)) = arr
        End With
    End With
End Sub

이 코드를 사용해보십시오

Function SPLITARR(ByRef v() As Variant, MaxRow As Integer) As Variant
  Dim ArraySize As Integer
  Dim MaxCols As Integer
  Dim NewArray() As Variant
  Dim x As Integer, y As Integer, z As Integer
  ArraySize = (UBound(v(), 1) - LBound(v(), 1)) + 1
  MaxCols = ArraySize \ MaxRow
  If ArraySize Mod MaxRow > 0 Then MaxCols = MaxCols + 1
  ReDim NewArray(LBound(v(), 1) To MaxRow, 1 To MaxCols)
  For x = LBound(v(), 1) To UBound(v(), 1)
    y = x Mod MaxRow
    If y = 0 Then y = MaxRow
    z = x \ MaxRow
    If x Mod MaxRow = 0 Then z = z - 1
    NewArray(y, z + 1) = v(x, 1)
  Next
  SPLITARR = NewArray()
End Function

와 같이 호출해야합니다

Sub caller()
Dim a() As Variant
a() = Range("A1",Range("A" & Rows.Count).End(xlUp))
a() = SPLITARR(a(), 5) '<~ change this to your needs
ActiveCell.Resize(UBound(a(), 1), UBound(a(), 2)).Value = a()
End Sub

다음과 같은 출력을 제공합니다.