Как разделить длинный список на равные группы в Excel?

Если у вас есть длинный список данных, который нужно разделить на несколько равных групп, как показано на следующем скриншоте, как можно быстро и легко справиться с этой задачей в Excel?

Разделение длинного списка на несколько равных групп с помощью кода VBA

Разделение длинного списка на несколько равных групп с помощью Kutools для Excel

Разделение длинного списка на несколько равных групп с помощью кода VBA

Помимо копирования и вставки данных по одному, следующий код VBA также может помочь вам. Пожалуйста, выполните следующие шаги:

1. Нажмите и удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic для приложений.

2. Щелкните Вставить > Модуль и вставьте следующий код в окно Модуля.

Код VBA: Разделение длинного списка на несколько равных групп

Sub SplitIntoCellsPerColumn()
'updateby Extendoffice
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xCell As Range
    Dim xTxt As String
    Dim xOutArr As Variant
    Dim I As Long, K As Long
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
Sel:
    Set xRg = Nothing
    Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Areas.Count > 1 Then
        MsgBox "does not support multiple selections, please select again", vbInformation, "Kutools for Excel"
        GoTo Sel
    End If
    If xRg.Columns.Count > 1 Then
        MsgBox "does not support multiple columns,please select again", vbInformation, "Kutools for Excel"
        GoTo Sel
    End If
    Set xOutRg = Application.InputBox("please select a cell to put the result:", "Kutools for Excel", , , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    I = Application.InputBox("the number of cell per column:", "Kutools for Excel", , , , , , 1)
    If I < 1 Then
        MsgBox "incorrect enter", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    ReDim xOutArr(1 To I, 1 To Int(xRg.Rows.Count / I) + 1)
    For K = 0 To xRg.Rows.Count - 1
      xOutArr(1 + (K Mod I), 1 + Int(K / I)) = xRg.Cells(K + 1)
    Next
    xOutRg.Range("A1").Resize(I, UBound(xOutArr, 2)) = xOutArr
End Sub

3. Затем нажмите клавишу F5, чтобы запустить этот код, и в появившемся окне выберите столбец, который вы хотите разделить на несколько групп, см. скриншот:

4. Нажмите кнопку ОК, затем выберите ячейку, где вы хотите разместить результат в следующем диалоговом окне, см. скриншот:

5. Нажмите ОК и введите количество ячеек, которые вы хотите разделить на столбцы в диалоговом окне, см. скриншот:

6. Наконец, нажмите ОК, чтобы завершить выполнение кода, и выбранные данные списка будут разделены на несколько равных групп, как вам нужно, см. скриншот:

Разделение длинного списка на несколько равных групп с помощью Kutools для Excel

Если вы установили Kutools для Excel, с помощью функции Преобразовать диапазон вы можете быстро разделить длинный список на несколько столбцов и строк. Кроме того, вы также можете объединить несколько столбцов в один длинный список.

После установки Kutools для Excel выполните следующие действия:

1. Выберите длинный список, который вы хотите разделить, а затем щелкните Kutools > Диапазон > Преобразовать диапазон, см. скриншот:

2. В диалоговом окне Преобразовать диапазон выберите Одна колонка в диапазон в разделе Тип преобразования, затем отметьте Фиксированное значение и укажите количество ячеек на строку в поле, см. скриншот:

3. Затем нажмите ОК и выберите ячейку, где вы хотите разместить результат в диалоговом окне, см. скриншот:

4. Нажмите кнопку ОК, и данные в списке будут разделены на несколько равных групп, как вам нужно.

Скачайте и попробуйте Kutools для Excel прямо сейчас!