-1

我有一个看起来像这样的表：

  |   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 对象模型不是很熟悉。

4

3 回答 3

4

这会成功的。它也是动态的，支持尽可能多的语言列，每人使用尽可能多的语言。假设数据按照示例格式化：

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
于 2013-04-03T09:30:27.133 回答
0

凌乱但应该工作：

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

然后只需排序

于 2013-04-02T22:18:28.683 回答
0

以下公式应该有效。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 中添加列标题，然后将公式自动填充到工作表中。

于 2013-04-02T22:29:41.790 回答