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

そして、言語列が 1 つしかないテーブルを生成したいと考えています。他の 2 つの言語列は、次のように新しい行になります。

   |   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

これでうまくいきます。また、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
于 2013-04-03T09:30:27.133 に答える
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 に答える
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 に答える