Следующий лист Excel должен быть переставлен
от
ID Name1 Name2 Name3
1 Alf Bert Fritz
2 Curt
3 Otto Mike
4 Sue Zack
в
ID Name
1 Alf
1 Bert
1 Fritz
2 Curt
3 Otto
3 Mike
4 Sue
4 Zack
Мне не хватает подходящего поискового термина, думаю, это довольно распространенное явление, но я просто не могу описать его должным образом.
У вас есть макет сводной таблицы, который вы хотите "развернуть". В этой статье Джона Уокенбаха показано, что вы можете сделать с помощью всего нескольких нажатий клавиш, и код VBA не требуется.
Для вашей конкретной ситуации вот что я бы сделал.
1.Откройте "старое" меню сводной таблицы, используя Alt + D, P. Вы получите диалоговое окно, подобное показанному ниже. Выберите "Несколько диапазонов консолидации" и нажмите "Далее".
2.На следующем шаге выберите "Я создам поля страницы"; Нажмите кнопку "Далее".
3.Выделите диапазон ячеек, чтобы он был определен в верхней части диалогового окна, затем нажмите кнопку "Добавить", чтобы скопировать этот диапазон в список "Все диапазоны". Нажмите кнопку "Далее".
4.Выберите ячейку подальше от ваших данных. Здесь вы видите, что я выбрал F3 на том же листе. (Вы можете выбрать другой лист, если хотите.) Нажмите "Готово".
5.Вы получите сводную таблицу, как это. В диалоговом окне снимите флажки "Строка" и "Столбец".
6.Это дает вам сводную таблицу с одной ячейкой.
7.Затем вы дважды щелкнете по одной ячейке, и на новом листе вы получите ваши «неповернутые» данные в виде новой таблицы:
Используя эти данные таблицы, теперь вы можете отфильтровать столбец C, чтобы отобразить непустые пробелы, и вы можете удалить столбец B, и у вас будет желаемый макет.
Попробуйте этот код. Это говорит само за себя в силу работы шаг за шагом. Ваши входные данные начинаются с A1, а ваши выходы начинаются с A8. Это можно изменить.
Более короткий код, конечно, возможен, и я предполагаю, что формула массива также может быть составлена.
Sub single_col()
Dim icell As Integer
Dim irow As Integer, icol As Integer
Dim nrows As Integer, ncols As Integer
Dim rng_all As Range, rng_curr As Range, rng_trg As Range
Set rng_all = Range("A2:D5")
Set rng_trg = Range("A8")
nrows = rng_all.Rows.Count
icell = 0
For irow = 1 To nrows
Set rng_curr = rng_all.Rows(irow)
ncols = WorksheetFunction.CountA(rng_curr)
For icol = 2 To ncols
icell = icell + 1
Dim name As String
name = rng_curr.Cells(1, icol).Text
rng_trg.Value = rng_curr.Cells(1, 1).Text
rng_trg.Offset(0, 1).Value = name
Set rng_trg = rng_trg.Offset(1, 0)
Next icol
Next irow
End Sub
PS: код выше уже включает в себя модификацию, предложенную в комментарии.