| |
こんにちは。かみちゃん です。
すでにKeinさんからもコメントが出ていますが、前回のコードの変更をすればできますので、ご紹介したいと思います。
前回、提示しましたコードは以下のとおりです。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=17548;id=excel
今回の修正にあたって、以下の変数の宣言を追加してください。
Dim MaxRow As Long, RowNo As Long, ColumnNo As Integer
そして、前回提示したコードの中に以下のコードがあると思います。
> '変形後の表の大きさを取得
> MaxColumn = Range("A1").CurrentRegion.Columns.Count
この下に以下のコードを挿入してください。
MaxRow = Range("A1").CurrentRegion.Rows.Count
'変形処理（列方向へ挿入したセルを行方向へ展開）
RowNo = 2
Do Until RowNo > MaxRow
For ColumnNo = 2 To MaxColumn
If Cells(RowNo, ColumnNo).Value <> "" Then
If ColumnNo > 2 Then
Rows(RowNo).Copy
Rows(RowNo + 1).Insert Shift:=xlDown
RowNo = RowNo + 1
MaxRow = MaxRow + 1
Application.CutCopyMode = False
Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 2)
End If
Else
Exit For
End If
Next
RowNo = RowNo + 1
Loop
'列方向へ挿入した列全体を削除
Range(Columns(3), Columns(MaxColumn)).Delete Shift:=xlToLeft
これで、ご希望の展開ができると思います。（動作確認済み）
|
|
かみちゃん
- 04/9/4(土) 11:30 -
