Excel将列转换为新行 [英] Excel convert columns to new rows

问题描述

我有一张表格，如下所示：

I have a table that looks like this:

  |   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    |

而且我想生成一个只有一个语言列的表。另外两个语言列应该是这样的新行：

And I want to generate a table that has only one language column. The other two language columns should become new rows like this:

   |   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对象模型。

I understand this will probably will need a macro or something. If anybody point me in the right direction it would me much appreciate. I am not very familiar with VBA or the Excel object model.

推荐答案

这将做的伎俩。它也是动态支持尽可能多的语言列，每个人使用尽可能多的语言。
假设数据格式如下：

This will do the trick. It is also dynamic supports as many language columns as you want with as many languages per person. Assumes the data is formatted as per the example:

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

这篇关于Excel将列转换为新行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！