Сгруппировать несколько столбцов Excel в строки

Question

В настоящее время я работаю над колонкой с содержанием для комментария учителя.

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

В то же время я хотел бы вынуть каждое из слов в содержании и затем поместить их в строки вместо столбцов.

Пример:

Кэтрин хорошая девушка. -> Это комментарий учителя.

После делимита в Excel у меня есть «Екатерина хорошая девочка» в 6 столбцах с 1 столбцом для 1 слова.

Тем не менее, я хотел бы, чтобы результаты слов были размещены в строках. Это будет выглядеть так, в 6 строк:

Catherine
is
a
good
girl
.

Answer 1

Excel имеет возможность сделать это.

1. Скопируйте данные в один или несколько столбцов или строк.

2. Прежде чем вставить скопированные данные, щелкните правой кнопкой мыши первую ячейку назначения (первую ячейку строки или столбца, в которую вы хотите вставить свои данные), а затем нажмите Специальная вставка.

3. В диалоговом окне «Специальная вставка» выберите «Транспонировать» и нажмите «ОК».

Вы найдете флажок транспонирования в правом нижнем углу диалогового окна:

Эта статья взята из справки по Excel 2003, но этот процесс применяется вплоть до новейшей версии Excel. Диалоговое окно может выглядеть иначе.

Answer 2

Следующий код VBA добьется цели.

Sub FlattenToSingleCol()
    Cells(1, 1).Activate ' Go to the top left

    ' Go past the last row that starts with a word
    Do Until IsEmpty(ActiveCell)
        DoEvents
        ActiveCell.Offset(1).Select
    Loop

    ' Set curRow to the last row that starts with a word (the row above ActiveCell)
    curRow = ActiveCell.Row - 1

    Do While curRow > 0
        DoEvents
        Cells(curRow, 1).Activate

        ' Go right past the last cell that contains a word
        Do Until IsEmpty(ActiveCell)
            DoEvents
            ActiveCell.Offset(0, 1).Activate
        Loop

        ' Come back left to the last cell that contains a word
        If ActiveCell.Column > 1 Then
            ActiveCell.Offset(0, -1).Activate
        End If

        ' Insert a new row below the current one for each
        Do Until ActiveCell.Column = 1 ' Move each non-empty cell to a new row and move left to the edge
            DoEvents
            ActiveCell.Offset(1).EntireRow.Insert
            Cells(ActiveCell.Row + 1, 1).Value = ActiveCell.Value
            ActiveCell.Clear
            ActiveCell.Offset(0, -1).Select
        Loop

        ' Go to the row above. Processing from the bottom up avoids re-processing lines we just inserted below.
        curRow = ActiveCell.Row - 1
    Loop
End Sub