Как перенести повторяющиеся строки в столбцы в 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. Нажмите OKи выберите одну ячейку, в которую вы хотите поместить результат, в следующем диалоговом окне, см. снимок экрана:
5. Затем нажмите OK , выбранные вами данные были преобразованы в следующее:
Разблокируйте магию Excel с помощью Kutools AI
- Умное исполнение: выполнение операций с ячейками, анализ данных и создание диаграмм — и все это осуществляется с помощью простых команд.
- Пользовательские формулы: Создавайте индивидуальные формулы для оптимизации рабочих процессов.
- VBA-кодирование: Пишите и внедряйте код VBA без особых усилий.
- Интерпретация формулы: Легкое понимание сложных формул.
- Перевод текста: преодолевайте языковые барьеры в своих таблицах.
Статьи по теме:
Как транспонировать / преобразовать столбцы и строки в одну строку?
Как транспонировать / преобразовать столбцы и строки в один столбец?
Как транспонировать / преобразовать один столбец в несколько столбцов в Excel?
Лучшие инструменты для офисной работы
Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего...
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!