[[20100711175046]]　『複数行データを一行に』（インテグラ）　ページの最後に飛ぶ

『複数行データを一行に』（インテグラ）

マクロ初心者です。エクセルマクロ（ＶＢＡ）に関して悩んでいます。助けてください。お願いいたします。
以下のようにある複数行あるデータを一行にまとめたいのですが、どうしたらよろしいでしょうか？
また、親識別ID 0をスタート値とし、次の0の手前でマクロが終了し、その後、次の親識別ID 0にセルを移し、空欄でなければ再度マクロを実行するようにしたいんです。

　親識別ID　　自己ID　　コメント発言時刻　　住所　コメント

   　0（親）          1      　 6:00:00         東京         c2
   　1（ID1の子）    10         6:01:00         東京         c2 
   　1（ID1の子）    11         6:02:00         神奈川       c2
   　1（ID1の子）    12         6:03:00         神奈川       c2
     0（親）          4         6:04:00         群馬         c2
   　2（ID2の子）    21         6:05:00         群馬         c2
   　2（ID2の子）    22         6:08:00         群馬         c2
     0（親）          7         6:10:00         埼玉         c3
   　3（ID3の子）    31         6:13:00         埼玉         c3
   　3（ID3の子）    32         6:23:00         埼玉         c6

以上のデータを以下の様に違うシートに置き換えたいと考えています。

親識別ID数(No)　子の数　　親ID　　時刻差　　　名前・コメント分類

    1               3        1     0:03:00     複数住所・単一コメント
    2               2        4     0:04:00     単一住所・単一コメント
    3               2        7     0:13:00     単一住所・複数コメント

VBAをどのように書いたら、このようにまとめることができますか？教えてください。宜しくお願いいたします。

名前・コメント分類とは

　東京－c2、神奈川－c2 東京と神奈川・・・複数の住所があるので複数住所
　　　　　　　　　　　　　　　c2　　・・・単一コメントなので、単一コメント
∴（複数住所・単一コメント）

　群馬－c2　群馬・・・単一の住所なので単一住所
　　　　　 c2 ・・・単一コメントなので、単一コメント
∴（単一住所・単一コメント）

  埼玉－c3   埼玉・・・単一の住所なので単一住所
  埼玉－c6  c3,c6・・・複数のコメントなので、複数コメント
∴（単一住所・複数コメント）

 すみません…
 内容の全てにおいて
 自分には難しくて意味が分かりません！
 時刻差？

 親Ａは名前ですか？で、名前の欄のｔ１とｔ２の親は同じってこと
 ですかね？やっぱりよく分からないです。。。

 （プレリュード）

 Pivotでもできそうな気が･･･

 （黒バラ）

 配列で処理すると、もっとシンプルなコードになるのでしょう・・
 まだまだ初心者なので、数少ないツールを組み合わせただけの下手なコードになっちゃいました。。^^;
 たたき台程度です。。

 <Sheet1>
     A        B           C         D          E         F
  1  親　　親識別ID　   自己ID　　 時刻　　  名前　   コメント
  2  A　　    0           1      6:00:00      t1        c2
  3  A　      1          10      6:01:00      t1        c2 
  4  A　　    1          11      6:02:00      t2        c2
  5  A　　    1          12      6:03:00      t2        c2
  6  A        0           4      6:04:00      t3        c2
  7  A　　    2          21      6:05:00      t3        c2
  8  A　　    2          22      6:08:00      t3        c2
  9  B        0           7      6:10:00      t4        c3
 10  B　　    3          31      6:13:00      t4        c3
 11  B　　    3          32      6:23:00      t4        c6

 <Sheet2>
    A       B               C        D        E               F
  1 親　親識別ID数(No)　　子の数　　親ID　　時刻差　　　名前・コメント分類 
  2 A      1               3         1     0:03:00     複数名前・同一コメント
  3 A      2               2         4     0:04:00     同一名前・同一コメント
  4 B      1               2         7     0:13:00     同一名前・複数コメント

 上記図表のシート配列で作成しました。。

 <考え方>
 1.Sheet1のB列の親識別IDが"0"で、かつ空白でない「行」を For～Next でH列に列記し、最後に最下行の一つ下の行を取り出す。。
 2.Sheet2のデータの置き換え範囲をクリアする。
 3.1で取り出した「行データ」を For Each Next で上から順に「行データ」を利用して、Sheet2の置き換えデータを作り上げる。。
 4.必要のない作業セルをクリアする。

 標準モジュールに貼り付けて実行してみて。。
     ↓
 Sub test()
    Dim i As Long
    Dim c As Range, myR As Range

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 2).Value = 0 And Cells(i, 2).Value <> "" Then
            Cells(Rows.Count, 8).End(xlUp).Offset(1).Value = i
        End If
    Next i
    Cells(Rows.Count, 8).End(xlUp).Offset(1).Value = Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Sheet2")
        Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 6).Value = ""
        .Range("A1:F1").Value = [{"親","親識別ID数(No)","子の数","親ID","時刻差","名前・コメント分類"}]
        Set myR = Range(Range("H2"), Cells(Rows.Count, 8).End(xlUp))
        For Each c In myR
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = Cells(c.Value, 1).Value
            .Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = Cells(c.Value, 2).Offset(1).Value
            If c.Offset(1).Value <> "" Then
                .Cells(Rows.Count, 3).End(xlUp).Offset(1).Value = c.Offset(1).Value - c.Value - 1
                .Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Cells(c.Offset(1).Value - 1, 4).Value - Cells(c.Value, 4).Value
                If WorksheetFunction.CountIf(Range(Cells(c.Value, 5), Cells(c.Offset(1).Value - 1, 5)), Cells(c.Value, 5)) = _
                                                                                                  c.Offset(1).Value - c.Value Then
                    .Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = "同一氏名"
                Else
                    .Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = "複数氏名"
                End If
                If WorksheetFunction.CountIf(Range(Cells(c.Value, 6), Cells(c.Offset(1).Value - 1, 6)), Cells(c.Value, 6)) = _
                                     c.Offset(1).Value - c.Value Then
                    .Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = "同一コメント"
                Else
                    .Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = "複数コメント"
                End If
                .Cells(Rows.Count, 6).End(xlUp).Value = _
                                                .Cells(Rows.Count, 6).End(xlUp).Value & "・" & .Cells(Rows.Count, 7).End(xlUp).Value
            End If
            .Cells(Rows.Count, 4).End(xlUp).Offset(1).Value = Cells(c.Value, 3).Value
        Next c
        .Range("E:E").NumberFormatLocal = "h:mm:ss"
        Range(Range("H2"), Cells(Rows.Count, 8).End(xlUp)).Value = ""
        Range(.Range("G2"), .Cells(Rows.Count, 7).End(xlUp)).Value = ""
    End With
 End Sub
 (kei)

 今頃になって気が付いたのですが、、
 わたしのマクロは、インテグラさんが最初に出された質問に対応したものでした。
 質問自体を編集されたので、、このマクロはちゃんと動きません。><
 (kei)

コメント返信：

[ 一覧(最新更新順) ]

[[20100711175046]] 『複数行データを一行に』（インテグラ） ページの最後に飛ぶ

[[20100711175046]]　『複数行データを一行に』（インテグラ）　ページの最後に飛ぶ