エクセル表の並び替えに関して

エクセル2002です。

--- K1|K2|K3|K4|
----------------
9/2|A |- |B |- |
9/3|- |A |A |B |
9/4|B |- |A |B |
9/5|- |- |- |A |

を

A|K1|9/2|---|---|
A|K2|9/3|---|---|
A|K3|9/3|9/4|---|
A|K4|9/5|---|---|
B|K1|9/4|---|---|
B|K2|---|---|---|
B|K3|9/2|---|---|
B|K4|9/3|9/4|---|

と別の場所あるいはべつのシートに並び替える方法はあるでしょうか？--の部分は空白です。
元表の列も行も増える可能性があります。
すみませんがぜひよろしくお願いいたします。

No.2 ベストアンサー 回答者： BLUEPIXY 回答日時： 2004/09/20 21:57

Public Sub convert()

Dim r As Range
Dim base As Range

Set r = ActiveCell.CurrentRegion 'アクティブセルのある範囲
'Set r = Selection '範囲を指定
SYMBOLS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
SYMLEN = Len(SYMBOLS)

Set base = Range("sheet2!A1") '書き込みの基準位置
ActiveWorkbook.Sheets("sheet2").Range("1:65536").ClearContents '書き込み先の消去

xMax = r.Columns.Count
yMax = r.Rows.Count
dataC = 0
valueC = 0

For i = 1 To SYMLEN
code = Mid$(SYMBOLS, i, 1)
For x = 2 To xMax
For y = 2 To yMax
If r.Cells(y, x) = code Then
If valueC = 0 Then
base.Offset(dataC, 0).Value = code
base.Offset(dataC, 1).Value = r.Cells(1, x)
base.Offset(dataC, 2).Value = r.Cells(y, 1)
base.Offset(dataC, 2).NumberFormatLocal = "m/d" '書式の設定
valueC = 3
Else
If base.Offset(dataC, 0) = code And base.Offset(dataC, 1) = r.Cells(1, x) Then
base.Offset(dataC, valueC).Value = r.Cells(y, 1)
base.Offset(dataC, valueC).NumberFormatLocal = "m/d" '書式の設定
valueC = valueC + 1
Else
dataC = dataC + 1
base.Offset(dataC, 0).Value = code
base.Offset(dataC, 1).Value = r.Cells(1, x)
base.Offset(dataC, 2).Value = r.Cells(y, 1)
base.Offset(dataC, 2).NumberFormatLocal = "m/d" '書式の設定
valueC = 3
End If
End If
End If
Next y
Next x
Next i
End Sub
とりあえず、作ってみました。
Ｂ｜Ｋ２は、データなしで表示（処理）しないようになっています。
該当の表の中のセルをセレクトしておいてマクロを呼び出します。
結果は、"sheet2"へ書き出します

この回答へのお礼

ありがとうございます。参考にさせていただき、勉強させていただきたいと思います。
もっと簡単なものと考えていたのですが、自分の未熟さを痛感しています。
ありがとうございました。

お礼日時：2004/09/21 14:51

No.1 回答者： imogasi 回答日時： 2004/09/20 21:06

関数による解答を期待しておられるかもしれませんが、

難しいと思います。Sheet2のあるセルを考えた時、そこにくるべきSheet1のセルがどこかを式で割り出すことは、非常に複雑になると思われ、事実上不可能でしょう。
するとVBAを使うことになりますが、VBAでも少し経験がないと、ロジックが難しい。取りあえず近いところまでやって見ましたた。
Sheet１のB2:E５を範囲指定して実行します。
Sub test01()
Dim sh1, sh2 As Worksheet
Dim cl As Range
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
j = 1
For Each cl In Selection
If cl <> "-" Then
sh2.Cells(j, "A") = cl
sh2.Cells(j, "B") = sh1.Cells(1, cl.Column)
sh2.Cells(j, "C") = sh1.Cells(cl.Row, 1)
j = j + 1
End If
Next
'------
sh2.Range(sh2.Cells(1, "A"), sh2.Cells(j, "C")).Sort Key1:=sh2.Range("A1"), _
Order1:=xlAscending, Key2:=sh2.Range("B1"), Order2:=xlAscending
'------
For i = 1 To j
' (略)
Next i
End Sub
これで
A K12004/9/2
A K22004/9/3
A K32004/9/3
A K32004/9/4
A K42004/9/5
B K12004/9/4
B K32004/9/2
B K42004/9/3
B K42004/9/4
になりますが、同一日を１行にまとめるのに更にプログラムコードの追加が必要です（略）。
それでも該当のないBのK2行を空白にすることが出来ていません。
K1からK4が４つとか少ないなら、むしろ違うロジックでプログラムを組む方がよいかも知れない。
それと、Sheet1で追加したら、即座にSheet2に反映するのもあきらめてください。
上記は、Sheet1のデータ入力の区切りの良いところで毎回プログラムを手動実行するものです。

この回答へのお礼

早速ありがとうございます。ちょっと自分にはレベルが高すぎる回答でした。参考にさしていただいて、勉強したいと思います。
補足ですが、A,B,K1-K4のところは手打ちしたいと思っております。
回答ありがとうございました。

お礼日時：2004/09/20 21:23