Как транспонировать повторяющиеся строки в столбцы в Excel?
Предположим, у вас есть диапазон данных в Excel, и вы хотите транспонировать повторяющиеся строки в несколько столбцов, как показано на следующем скриншоте. Есть ли у вас какие-либо хорошие идеи для решения этой задачи?
Транспонирование повторяющихся строк в столбцы с помощью кода VBA
Транспонирование повторяющихся строк в столбцы с помощью кода VBA
К сожалению, в Excel нет прямого способа справиться с этим, но вы можете создать код VBA для решения проблемы. Пожалуйста, выполните следующие действия:
1. Удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic for Applications.
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. Нажмите OK и выберите ячейку, куда вы хотите поместить результат в следующем диалоговом окне, см. скриншот:
5. Затем нажмите кнопку OK, и ваши выбранные данные будут преобразованы следующим образом:
Раскройте магию 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-дневная полнофункциональная пробная версия — без регистрации и кредитной карты
- Лучшее соотношение цены и качества — экономия по сравнению с покупкой отдельных надстроек