横方向の表を縦方向に

e0080122_7313821.gif
めったにないかもしれないが、上図の様にデータが横方向に並んだ表があったとしたら
後々集計するのが難しい場合がある。
そんな時に、この表を分解して縦方向へと作成するマクロを作ってみた。

Sub 縦方向の表へ()
 Dim c As Long
 Dim r As Long
 Dim i As Long
 Dim j As Long

  r = Sheets(1).UsedRange.Rows.Count

  With Sheets(2).Range("a1")
    .Value = "購入者"
    .Offset(, 1).Value = "商品名"
  End With 'とりあえずSheet2に放出するために準備

 For i = 2 To r
   c = Sheets(1).Cells(i, 1).End(xlToRight).Column
     For j = 2 To c
       If Sheets(1).Cells(i, j).Value <> "" Then
         With Sheets(2).Range("B65536").End(xlUp)
            .Offset(1).Value = Sheets(1).Cells(i, j).Value
            .Offset(1, -1).Value = Sheets(1).Cells(i, 1).Value
         End With
       End If
     Next
 Next
End Sub

何だかかなり無理やり・・・な感じもするが、一応目的の表は出来たので良しとする。
e0080122_7402969.gif

[PR]
by slayer0210 | 2005-11-22 07:42 | マクロ


<< IFとANDで合否判定(配列) 目次シートの作成(相互リンク?) >>