0

次の表があります。

Name        Group
John        2A
John        1B
Barry       2A
Ron         1B
Ron         2A
Ron         2C

グループ列を各インスタンスの新しい列に分割できる Excel のユーティリティがあるかどうかを知りたいと思いました。

期待される結果

Name        Group1      Group2      Group3
John        2A          1B
Barry       2A
Ron         1B          2A          2C

この例では、グループの最大数が 3 であることを知っています。そのため、Group1、Group2、および Group3 列を作成しました。

4

2 に答える 2

1

2C が B7 にあり、コピーに取り組んでいると仮定すると、次のようになります。

=IF(COLUMN()<COUNTIF($A:$A,$A2)+2,IF($A2=$A3,INDIRECT("$B"&ROW()+COLUMN()-2),""),"")

C2でコピーし（必要に応じてColumnZまたはそれ以上にコピーしますが、例ではColumnDで十分です）、適切に下にコピーします。

使用可能な列に次のように入力します。

=OR(A1=A3,A1=A2)

合わせてコピーします。

数式を修正し (選択/コピー/貼り付け)、「利用可能な」列をフィルター処理して TRUE を選択し、選択した行を削除して、「利用可能な」列を削除します。列ラベルを適宜追加します。

于 2013-08-09T18:05:13.300 に答える
0

変換されたテーブルを新しいシートに配置する VBA ソリューションを次に示します。

Sub tgr()

    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim NameCell As Range
    Dim rngFound As Range
    Dim arrData() As Variant
    Dim strFirst As String
    Dim DataIndex As Long
    Dim cIndex As Long

    Set wsData = ActiveSheet
    Set wsDest = Sheets.Add(After:=Sheets(Sheets.Count))
    wsData.Range("A1", wsData.Cells(Rows.Count, "A").End(xlUp)).AdvancedFilter xlFilterCopy, , wsDest.Range("A1"), True
    wsData.Range("B1", wsData.Cells(Rows.Count, "B").End(xlUp)).AdvancedFilter xlFilterCopy, , wsDest.Range("B1"), True
    wsDest.Range("B2", wsDest.Cells(Rows.Count, "B").End(xlUp)).Copy
    wsDest.Range("B1").PasteSpecial xlPasteValues, Transpose:=True
    With wsDest.Range("A1", wsDest.Cells(1, Columns.Count).End(xlToLeft))
        .Font.Bold = True
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        With .Offset(, 1).Resize(, .Columns.Count - 1)
            .Value = Application.Transpose(Evaluate("Index(""Group""&Row(1:" & .Columns.Count & "),)"))
        End With
    End With
    ReDim arrData(1 To wsDest.Cells(Rows.Count, "A").End(xlUp).Row - 1, 1 To wsDest.Cells(1, Columns.Count).End(xlToLeft).Column - 1)
    For Each NameCell In wsDest.Range("A2", wsDest.Cells(Rows.Count, "A").End(xlUp)).Cells
        DataIndex = DataIndex + 1
        Set rngFound = wsData.Columns("A").Find(NameCell.Text, , xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            cIndex = 0
            strFirst = rngFound.Address
            Do
                cIndex = cIndex + 1
                arrData(DataIndex, cIndex) = wsData.Cells(rngFound.Row, "B").Text
                Set rngFound = wsData.Columns("A").Find(NameCell.Text, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    Next NameCell

    If DataIndex > 0 Then wsDest.Range("B2").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData

    Set wsData = Nothing
    Set wsDest = Nothing
    Set NameCell = Nothing
    Set rngFound = Nothing
    Erase arrData

End Sub

マクロの使用方法:

  1. マクロが実行されるワークブックのコピーを作成します
    • コードがスムーズに実行されない場合に備えて、常にワークブックのコピーで新しいコードを実行する
    • これは、何かを削除するコードに特に当てはまります。
  2. コピーしたブックで Alt キーを押しながら F11 キーを押して、Visual Basic Editor を開きます。
  3. 挿入 | モジュール 提供されたコードをコピーして、モジュールに貼り付けます
  4. Visual Basic エディターを閉じる
  5. Excel で、ALT+F8 を押して、実行可能なマクロのリストを表示します。
  6. 目的のマクロをダブルクリックします (これを tgr と名付けました)
于 2013-08-09T18:04:36.593 に答える