『マクロで縦のデータを横に』（koko）

宜しくお願いします。

「入所退所データ」シートの
Ｄ列に入所者コードが入力
Ｅ列に”入所”又は”退所”のどちらかが入力
Ｉ列に日付
このようなデータが約7000行ほどあります。


Ｄ　　　　　Ｅ　　　　　Ｉ　　　　　　
105　　　入所　　　ｈ20/2/1　　　　
105　　　退所　　　ｈ21/1/5　　　　
105　　　入所　　　ｈ21/5/1　　　　
177　　　入所　　　ｈ18/5/10　　　
177　　　退所　　　ｈ19/2/10　　 　
280　　　入所　　　ｈ25/5/15　　 　

これをSheet2に

Ｃ　　　　　　Ｄ　　　　　　　　Ｅ         
コード   　　入所日　　　　　退所日 　　　
105　　　　ｈ20/2/1 　　 　ｈ21/1/5　     
105　　　　ｈ21/5/1　　　　　　　　　　
177　　　　ｈ18/5/10　　　ｈ19/2/10
280　　　　ｈ25/5/15　

このような形に並べ替えをしたいのですが、
どうにもややこしくて、手におえません。
どうか宜しくお願い致します。




＜ 使用 Excel：Excel2007、使用 OS：WindowsVista ＞
----
こんな感じで考えるとできそうに思えませんか。

１）E列を上から順にみていき
２）入所なら、D、I列を、シート２のC、D列に転記
３）退所なら、２）の行のE列に転記
４）これを繰り返す

（マナ） 2017/06/17(土) 19:28
----
マナ様

私が書くとこうなってしまうのです。
どこを変えればいいのか困っています。

コード 　　入所日　　　　　退所日 
105　　　　ｈ20/2/1
105　　　　　　　　 　　 　ｈ21/1/5　 
105　　　　ｈ21/5/1　　　　　　　　　　 
177　　　　ｈ18/5/10　
177　　　　　　　　　　　　ｈ19/2/10 
280　　　　ｈ25/5/1

下記のコードです
Sub test()
 Dim maxrow  As Long
 Dim mysh As Worksheet
 Dim mysh2 As Worksheet
 Dim i As Long
 Dim j As Long
 
 Set mysh = Worksheets("入所退所")
 Set mysh2 = Worksheets("並べ替え")
 
   maxrow = mysh.Cells(Rows.Count, 4).End(xlUp).Row
  
   j = 2
   
   For i = 2 To maxrow
          mysh2.Range("c" & j).Value = mysh.Range("d" & i).Value
       
        If mysh.Range("e" & i).Value = "入所" Then
            mysh2.Range("ｄ" & j).Value = mysh.Range("i" & i).Value
        ElseIf mysh.Range("e" & i).Value = "退所" Then
            mysh2.Range("e" & j).Value = mysh.Range("i" & i).Value
        Else
        End If
     j = j + 1
     
   Next
   
End Sub

（koko） 2017/06/18(日) 00:57
----
＞２）入所なら、D、I列を、シート２のC、D列に転記 
＞３）退所なら、２）の行のE列に転記 

ここを言い換えると

２）入所なら、D、I列を、並べ替えシートの「新たな行」のC、D列に転記 
３）退所なら、「２）と同じ行」のE列に転記

並べ替えシートのどの行に転記するかは、変数j ですよね。

並べ替えシートを見ながらスッテプ実行（F8)すると
どこがおかしいかわかります。 

（マナ） 2017/06/18(日) 07:43
----
マナ様
ヒント有難うございます
下記のようにかえてみました。.例題の少ないデータならＯＫなのですが
実際の7000行のデータだとＣ列のコードとＤ列、Ｅ列がずれて転記されてしまいます。
明日までにこのデータが必要なので、今回は手動と関数でどうにかしてみます
有難うございました。

Sub test()
 Dim maxrow  As Long
 Dim mysh As Worksheet
 Dim mysh2 As Worksheet
 Dim i As Long
 Dim j As Long
  
 
 Set mysh = Worksheets("入所退所")
 Set mysh2 = Worksheets("並べ替え")
 
   maxrow = mysh.Cells(Rows.Count, 4).End(xlUp).Row
  
   j = 2
   
   For i = 2 To maxrow
          
           If mysh.Range("e" & i).Value = "入所" Then
                j = mysh2.Cells(Rows.Count, 4).End(xlUp).Row + 1
                mysh2.Range("c" & j).Value = mysh.Range("d" & i).Value
                mysh2.Range("ｄ" & j).Value = mysh.Range("i" & i).Value
             
           ElseIf mysh.Range("e" & i).Value = "退所" Then
                j = mysh2.Cells(Rows.Count, 4).End(xlUp).Row
               mysh2.Range("e" & j).Value = mysh.Range("i" & i).Value
           Else
           
           End If
      
   Next

End Sub

（koko） 2017/06/18(日) 09:23
----
＞下記のようにかえてみました。.例題の少ないデータならＯＫなのですが 
＞実際の7000行のデータだとＣ列のコードとＤ列、Ｅ列がずれて転記されてしまいます

D列、I列はソートされている必要があります。

（マナ） 2017/06/18(日) 10:30
----
 簡単に書いたつもりだけど、Step Debug してもわからないところがあったら質問を
 
 Sub test()
    Dim mysh As Worksheet, mysh2 As Worksheet, r As Range, n As Long
    Set mysh = Worksheets("入所退所")
    Set mysh2 = Worksheets("並べ替え")
    n = 1
    With mysh
        For Each r In .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            If r.Offset(, 1).Value = "入所" Then
                n = n + 1
                mysh2.Range("c" & n).Value = r.Value
                mysh2.Range("d" & n).Value = r.Offset(, 5).Value
            Else
                mysh2.Range("e" & n).Value = r.Offset(, 5).Value
            End If
        Next
    End With
End Sub
（seiya） 2017/06/18(日) 13:56
----
seiya　さんへ

・日付が西暦／月／日になってしまう
・コードが上書き（？）されてしまう
＝＞　105　　　　ｈ20/2/1 　　 　ｈ21/1/5　のデータが105　ｈ20/2/1　はなくなり、
ｈ21/1/5　が１行目の”退所日”を上書きして居座っている

といった感じでした。

＞Worksheets("入所退所")
には項目行がないからでしょうか？
Ｄ列の最初をＤ１としたらいけました。

日付については、kokoさんがどうしたいのか？で決まるのかも知れませんが。

　
（じゅんじゅん） 2017/06/18(日) 16:08
----
 日付の問題は単にセルの書式の問題だと思います。

 kokoさんのコードでは両シート共にヘッダーがあると思います。
 データのレイアウトが提示されているものであれば、提示された結果の通りになるはずですが？
（seiya） 2017/06/18(日) 16:43
----
seiyaさんへ

＞ kokoさんのコードでは両シート共にヘッダーがあると思います。

私もそう思うのですが、最初の質問文をコピペしたからでしょうね。
kokoさんのコードも２行目からになってますし、私の早とちりかもしれません。

日付についても、元々列で書式設定されているなら心配ないのかな？

お手数おかけ致しました。

（じゅんじゅん） 2017/06/18(日) 18:18
----
皆様　有難うございます

並べ替えはほぼ終わりました。
データがずれる原因ですが、
元データの方に原因がありました。
元データは個人別の日付順に並んでいるのですが、
入所、退所、入所、退所・・・と並ばないといけないのですが
一部の人のデータが入所、入所になっていたりする入力ミスがあり
それが並べ替えがうまくいかない原因でした。
入力ミスの有る人を消去して並べ替え実行してみたら
うまくいきました。


seiyaさんのコードは無駄がなく処理が早そうですね。
使わせていただきます。有難うございました。


（koko） 2017/06/18(日) 20:17