0

テーブルについて考えてみましょう。

a       b        c       d
key1   value1   value2   value3
key2   value1a           value3a

これをに変換する必要があります

Key1 Value1
Key1 Value2
Key1 Value3
Key2 Value1a
Key2 
key2 Value3a

このコードは、必要に応じてスペースを含め、すべてのデータを1つの列に配置するのに役立ちますが、最初の列をキーとして保持する必要があり、ExcelでVBAを初めて使用します。

  Sub MultiColsToA() 
Dim rCell As Range 
Dim lRows As Long 
Dim lCols As Long 
Dim lCol As Long 
Dim ws As Worksheet 
Dim wsNew As Worksheet 

lCols = Columns.Count 
lRows = Rows.Count 
Set wsNew = Sheets.Add() 

For Each ws In Worksheets 
    With ws 
        For Each rCell In .Range("B1", .Cells(1, lCols).End(xlToLeft)) 
            .Range(rCell, .Cells(lRows, rCell.Column).End(xlUp)).Copy _ 
            wsNew.Cells(lRows, 1).End(xlUp)(2, 1) 
        Next rCell 
    End With 
Next ws 

End Sub

テーブルは約55行で、12〜30列です。理想的には、同じ方法で20枚ほどのシートを変換する必要があるので、これをプログラムで行う方法が理想的です。

4

1 に答える 1

3

これは、そのようなものを機能させる方法の基本的な例です。うまくいけば、これは概念として役立ち、探しているものに最も合うように微調整することができます。

Sub MultiColsToA()

    Dim rCell As Range
    Dim cCell As Range
    Dim iCounter As Integer
    Dim iInner As Integer
    Dim ws As Worksheet
    Dim wsNew As Worksheet

    ' Find the full range of the original sheet (assumes each row
    ' in column A will have a value)
    Set rCell = Range("A1:A" & Range("A1").End(xlDown).Row)
    Set wsNew = Sheets.Add()

    For Each ws In Worksheets
        ' Set our sentinel counter to track the row
        iCounter = 1

        ' Iterate through each cell in the original sheet
        For Each cCell In rCell

          ' This will likely need to be adjusted for you, but
          ' here we set a counter = 1 to the number of columns
          ' the original sheet contains (here 3, but can be changed)
          For iInner = 1 To 3
              With wsNew
                  ' Set the first column = the key and the second the
                  ' proper value from the first sheet
                  .Cells(iCounter, 1).Value = cCell.Value
                  .Cells(iCounter, 2).Value = cCell.Offset(0, iInner).Value
              End With

              ' Increment the sentinel counter
              iCounter = iCounter + 1
          Next iInner
        Next cCell
    Next ws

End Sub
于 2012-11-26T15:24:16.823 に答える