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

以下公式应该有效。 sheet2中的数据总是反映sheet1上的数据，因此您不必重新运行宏来创建新列表。

话虽这么说，使用宏来生成它可能是一个更好的选择，因为如果你需要在以后添加第4种语言或其他东西，它将允许更多的灵活性。

在Sheet2！A2中

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

在Sheet2！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中添加列标题，然后在表格下方自动填充公式。

Excel将列转换为新行

3 个答案: