[[20130530084802]]　『複数列の一括入れ替え方法（至急）』（ちゃーーこ）　ページの最後に飛ぶ

『複数列の一括入れ替え方法（至急）』（ちゃーーこ）

下記のような一覧表で、
（それぞれの人が、その日付に何色を選んだか…のリストです。１行目が項目名）

なんらかの作業をして（なるべく簡単な）一括で、人名ごとに、左から日付順に並び替え＆入れ替えを行いたいのですが、方法を教えてください。

人名　日付　色　日付　色　日付　色
Ａ氏　5/30　緑　1/16　赤　8/12　黄
Ｂ氏　9/17　白　4/15　青　5/22　桃　

↓
この表を一括で

↓
人名　日付　色　日付　色　日付　色
Ａ氏　1/16　赤　5/30　緑　8/12　黄
Ｂ氏　4/15　青　5/22　桃　9/17　白

こうなるように左から日付順になるように
並び替え？入れ替え？を行いたいです。　

Excel2003 WindowsXPです。
宜しくお願い致します。

	A	B	C	D	E	F	G
1	人名	日付	色	日付	色	日付	色
2	Ａ氏	5月30日	緑	1月16日	赤	8月12日	黄
3	Ｂ氏	9月17日	白	4月15日	青	5月22日	桃
4							
5							
6							
7							
8	Ａ氏	1月16日	赤	5月30日	緑	8月12日	黄
9	Ｂ氏	4月15日	青	5月22日	桃	9月17日	白
10

 A8 =A2
 B8 =IF(B2="","",SMALL(2:2,COLUMN(B1)/2))
 C8 =IF(B8="","",INDEX(2:2,MATCH(B8,2:2,0)+1))

 B8:C8 右へコピー。

 8行目 下にコピー。

 8行目以下を元の票に値貼り付け

 ※同一行に同じ日付があるとNG

 (GobGob)

[[20121101111347]]　『配列の一括転記について』（まみー）

 1)範囲そのものを変換
 Sub test()
    With Cells(1).CurrentRegion
        .Value = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 4, 5, 2, 3, 6, 7))
    End With
End Sub

 2)範囲の下に変換したければ

 Sub test2()
    With Cells(1).CurrentRegion
        .Offset(.Rows.Count + 2).Value = _
        Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 4, 5, 2, 3, 6, 7))
    End With
End Sub
(seiya)
 Array のIndexを修正 11:03

 こんにちは

 配列の一括転記では対応出来ないケースのような気がします。

 Sub test()
    Dim mSh As Worksheet
    Dim tSh As Worksheet
    Dim h   As String

    Set mSh = Worksheets("Sheet1")  '修正元シート名
    Set tSh = Worksheets("Sheet2")  '一時使用シート名

    With mSh
        h = .Range("A1").CurrentRegion.Rows(2).Address(0, 1, xlA1, True)
        .Range("A1").CurrentRegion.Copy tSh.Range("A1")
        With tSh.Range("A1").CurrentRegion
            With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
                .Formula = _
                    "=IF(" & mSh.Name & "!B2="""",""""," & _
                    "IF(MOD(COLUMN(" & mSh.Name & "!B2),2)=0," & _
                    "SMALL(" & h & ",INT(COLUMN(" & mSh.Name & "!B2)/2))," & _
                    "OFFSET(" & mSh.Name & "!$A2,0,MATCH(A2," & h & ",0))))"
            End With
        End With
        .Range("A1").CurrentRegion.Value = tSh.Range("A1").CurrentRegion.Value
    End With
    tSh.Range("A1").CurrentRegion.ClearContents
End Sub

 （ウッシ）

 >  配列の一括転記では対応出来ないケースのような気がします。
 出来てるよ？
 (seiya)

 こんにちは

 人名　日付　色　日付　色　日付　色 
 Ａ氏　5/30　緑　1/16　赤　8/12　黄 
 Ｂ氏　9/17　白　4/15　青　5/22　桃　 
 ↓ 
 人名　日付　色　日付　色　日付　色 
 Ａ氏　1/16　赤　5/30　緑　8/12　黄 
 Ｂ氏　4/15　青　9/17　白  5/22　桃

 Ｂ氏の並びが日付順になってないと思います。
 違うかな・・・

 （ウッシ）

 ああ..
 >日付順
 これ見逃し...
 (seiya)

 これかな？
 Sub test()
    Dim a, i As Long, ii As Long, t As Long, e, w
    With Cells(1).CurrentRegion
        a = .Value
        With CreateObject("System.Collections.SortedList")
            For i = 2 To UBound(a, 1)
                For ii = 2 To UBound(a, 2) Step 2
                    If Not .Contains(a(i, ii)) Then
                        ReDim w(1 To 1)
                    Else
                        w = .Item(a(i, ii))
                        ReDim Preserve w(1 To UBound(w) + 1)
                    End If
                    w(UBound(w)) = a(i, ii + 1)
                    .Item(a(i, ii)) = w
                Next
                t = 1
                For ii = 0 To .Count - 1
                    For Each e In .GetByIndex(ii)
                        t = t + 1
                        a(i, t) = .GetKey(ii)
                        t = t + 1
                        a(i, t) = e
                    Next
                Next
                .Clear
            Next
        End With
        .Value = a
    End With
End Sub
(seiya)

http://excelfactory.net/excelboard/exgeneral/excel.cgi?mode=all&namber=117271&rev=0

 40分返事が無いだけで「至急」なんて描き足してマルチポストしてる割には全く返事無しとは全然「至急」ではないようだな。

 (マルチーズ)

掲示板の使い方が分からずに、ご迷惑おかけしました。
すいませんでした。
夕方までに知りたかったので、「至急」と書いてしましました。

皆さん、回答ありがとうございました。
seiyaさんの教えてくださったやり方で出来ました。

本当に本当に助かりました。
感謝です。

（ちゃーーこ）

コメント返信：

[ 一覧(最新更新順) ]

[[20130530084802]] 『複数列の一括入れ替え方法（至急）』（ちゃーーこ） ページの最後に飛ぶ

[[20130530084802]]　『複数列の一括入れ替え方法（至急）』（ちゃーーこ）　ページの最後に飛ぶ