Как транспонировать повторяющуюся строку в столбцы в Excel?
Предположим, у вас в Excel есть диапазон данных, и вы хотите транспонировать повторяющиеся строки в несколько столбцов, как показано на следующем снимке экрана. Знаете ли вы эффективные способы выполнить эту задачу?
Транспонирование Дублирующая строка в столбцы с помощью кода VBA

Транспонирование Дублирующая строка в столбцы с помощью кода VBA
К сожалению, Excel не предоставляет прямого способа выполнить эту операцию, но вы можете решить задачу с помощью собственного кода VBA. Следуйте инструкциям ниже:
1. Удерживайте нажатыми клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic для приложений.
2. Нажмите Вставка > Модуль и вставьте следующий код в окно Модуля.
Код VBA: транспонирование Дублирующая строка в несколько столбцов
Sub ConvertTable()
'Updateby Extendoffice
Dim xArr1 As Variant
Dim xArr2 As Variant
Dim InputRng As Range, OutRng As Range
Dim xRows As Long
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
xArr1 = InputRng.Value
t = UBound(xArr1, 2): xRows = 1
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(xArr1, 1)
If Not .exists(xArr1(i, 1)) Then
xRows = xRows + 1: .Item(xArr1(i, 1)) = VBA.Array(xRows, t)
For ii = 1 To t
xArr1(xRows, ii) = xArr1(i, ii)
Next
Else
xArr2 = .Item(xArr1(i, 1))
If UBound(xArr1, 2) < xArr2(1) + t - 1 Then
ReDim Preserve xArr1(1 To UBound(xArr1, 1), 1 To xArr2(1) + t - 1)
For ii = 2 To t
xArr1(1, xArr2(1) + ii - 1) = xArr1(1, ii)
Next
End If
For ii = 2 To t
xArr1(xArr2(0), xArr2(1) + ii - 1) = xArr1(i, ii)
Next
xArr2(1) = xArr2(1) + t - 1: .Item(xArr1(i, 1)) = xArr2
End If
Next
End With
OutRng.Resize(xRows, UBound(xArr1, 2)).Value = xArr1
End Sub
3. Нажмите клавишу F5, чтобы запустить этот код. В появившемся диалоговом окне выберите диапазон данных, из которого нужно преобразовать дублирующиеся строки в несколько столбцов (см. снимок экрана):

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

5.Затем нажмите кнопку ОК, и ваши Выбрать данные будут преобразованы следующим образом:


Раскройте магию Excel с помощью KUTOOLS AI
- Интеллектуальное выполнение: Выполняйте операции с ячейками, анализируйте данные и создавайте диаграммы — всё это доступно через простые команды.
- Пользовательские формулы: создавайте индивидуальные формулы для оптимизации рабочих процессов.
- Программирование на VBA: Пишите и внедряйте код VBA легко и без усилий.
- Анализ формул: Легко разбирайтесь даже в самых сложных формулах.
- Перевод текста: Ломайте языковые барьеры прямо в ваших таблицах.
Связанные статьи:
Как транспонировать или преобразовать столбцы и строки в одну строку?
Как транспонировать или преобразовать столбцы и строки в один столбец?
Как транспонировать или преобразовать один столбец в несколько столбцов в Excel?
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек