Excel преобразовать столбцы новых строк

Question

У меня есть таблица, которая выглядит следующим образом:

| A |  B  |  C  |  D  | 
    +-------+------------+------------+------------+ 
1 | Name | Language 1 | Language 2 | Language 3 | 
    +=======+============+============+============+ 
2 | John | English | Chinese | Spanish | 
3 | Wendy | Chinese | French  | English | 
4 | Peter | Spanish | Chinese | English | 

И я хочу, чтобы создать таблицу, которая имеет только один столбец языка. Остальные два столбца языка должны стать такими новыми строками:

| A | B  | 
    +-------+----------+ 
1 | Name | Language | 
    +=======+==========+ 
2 | John | English | 
3 | John | Chinese | 
4 | John | Spanish | 
5 | Wendy | Chinese | 
6 | Wendy | French | 
7 | Wendy | English | 
8 | Peter | Spanish | 
9 | Peter | Chinese | 
10 | Peter | English | 

Я понимаю, что это, вероятно, понадобится для макроса или чего-то еще. Если кто-то укажет мне в правильном направлении, я буду очень благодарен. Я не очень хорошо знаком с VBA или объектной моделью Excel.

Answer 1

Это сделает трюк. Он также динамически поддерживает столько столбцов языка, сколько вы хотите, с большим количеством языков на человека. Предполагает данные форматируются согласно примеру:

Sub ShrinkTable() 
    Dim maxRows As Double 
    Dim maxCols As Integer 
    Dim data As Variant 
    maxRows = Cells(1, 1).End(xlDown).row 
    maxCols = Cells(1, 1).End(xlToRight).Column 

    data = Range(Cells(1, 1), Cells(maxRows, maxCols)) 

    Dim newSht As Worksheet 
    Set newSht = Sheets.Add 

    With newSht 

     .Cells(1, 1).Value = "Name" 
     .Cells(1, 2).Value = "Column" 

     Dim writeRow As Double 
     writeRow = 2 

     Dim row As Double 
     row = 2 
     Dim col As Integer 

     Do While True 

      col = 2 
      Do While True 
       If data(row, col) = "" Then Exit Do 'Skip Blanks 

       'Name 
       .Cells(writeRow, 1).Value = data(row, 1) 

       'Language 
       .Cells(writeRow, 2).Value = data(row, col) 

       writeRow = writeRow + 1 
       If col = maxCols Then Exit Do 'Exit clause 
       col = col + 1 
      Loop 

      If row = maxRows Then Exit Do 'exit cluase 
      row = row + 1 
     Loop 

    End With 
End Sub 

Answer 2

Грязный, но должно работать:

For Each namething In Range("A1", Range("A1").End(xlDown)) 
    Range("A1").End(xlDown).Offset(1, 0) = namething.Value 
    Range("A1").End(xlDown).Offset(0, 1) = namething.Offset(0, 2) 
    Range("A1").End(xlDown).Offset(1, 0) = namething.Value 
    Range("A1").End(xlDown).Offset(0, 1) = namething.Offset(0, 3) 
    namething.Offset(0, 2) = "" 
    namething.Offset(0, 3) = "" 
Next 

Тогда просто отсортируйте

Answer 3

следующая формула должна работать. Данные на листе2 всегда будут отражать данные на листе1, поэтому вам не придется повторно запускать макрос для создания нового списка.

Это означает, что использование макроса для его создания, вероятно, является лучшим выбором, так как это позволит увеличить гибкость, если вам нужно добавить 4-й язык или что-то позднее.

В Лист2! A2

=INDIRECT("Sheet1!A"&ABS(INT((ROW()+1)/3))+1)

В Лист2! B2

=INDIRECT("Sheet1!"&IF(ABS(INT((ROW()+1)/3)-(ROW()+1)/3)=0,"B",IF(ABS(INT((ROW()+1)/3)-(ROW()+1)/3)=(1/3),"C","D"))&ABS(INT((ROW()+1)/3))+1)

Добавить заголовки столбцов в A1 и B1 затем автозаполнения формулу вниз листа.