ExcelVBA、データの抽出方法

Question

Excel VBA初心者です。

施設コード```
人名 識別種類 2015/7/1 2015/7/2 2015/7/3
K1 a 9：00 14：00 10：00
K1 b 10：00 15：00 22：00
K1 c 2 6
K2 a 8：00 13：00 13：00
K2 b 8：00 13：00 13：00
K2 c 3 6
K2 d 10:00 10:00 20:00

コード

上記の様なcsvファイルを下記の様に抽出したいのですが、どのような方法がありますでしょうか？

人名 当日日時 前日c有無 a b
K1 2015/7/1 × 9：00
K1 2015/7/2 × 15：00
K1 2015/7/3 ○
K2 2015/7/1 × 8：00 8:00
K2 2015/7/2 ○ 13:00 13:00
K2 2015/7/3 × 13：00 13:00
コード

条件
・データが空白な場所は無視
・データがある場合のみ追加


行単位でIf文・For文などを使い作ろうと試みているんですが、なかなかうまくいきません。何かいい方法などありますでしょうか？

コードの修正致しました。申し訳ございません。

宜しくお願い致します。

Comments

[yunn]

前日c有無の定義を教えてください。
あと、上のCSVに対して下の結果を出すのは不可能ではないですか？
例えば、K3さんのa,b情報はないのに結果には出てる、とか
K2さんのbの情報はあるけど10:00じゃなくて14:00になってる、とか。。。
曖昧な情報だと正しい回答は得にくいのではないかと思います。

[ian_is_dj]

コードの修正致しました。申し訳ございません。

[tomo.ina]

日付の列での時間を、人名ごとに識別種類を見てaかbか判断して
出力しているようですが、記載されているcsvファイルと処理結果が合っていないので
回答できないと思います。
あと「前日c有無」や識別種類の「d」が何かわからないので、
回答は難しいです．．．。

[jawa]

※修正依頼では改行等レイアウトが崩れてしまうため、回答欄にコメントさせていただきました。

[ian_is_dj]

tomo.ina様　jawa様

コメントありがとうございます。
データの方再度修正致しました。申し訳ございません。

jawa様
①おっしゃる通りです。1人につき複数記載されております
②全て1日単位で管理しており、1人につき各識別種類を1日一つ分ずつ記載しております複数はございません
③おっしゃる通り、初日はデータが無いため判定できません。そのため1日目は×で進めようと思っております。

たびたび申し訳ございません。宜しくお願い致します。

[ian_is_dj]

人名 識別種類 2015/7/1 2015/7/2 2015/7/3
K1 a 9：00 14：00 10：00
K1 b 10：00 15：00 22：00
K1 c 2 6
K2 a 8：00 13：00 13：00
K2 b 8：00 13：00 13：00
K2 c 3 6
K2 d 10:00 10:00 20:00

↓

人名 当日日時 前日c有無 a b
K1 2015/7/1 × 9：00 　10：00
K1 2015/7/2 × 14：00 　15：00
K1 2015/7/3 ○
K2 2015/7/1 × 8：00 8:00
K2 2015/7/2 ○ 13:00 13:00
K2 2015/7/3 × 13：00 13:00

これで間違いないはず・・・？

Answer 1

（※修正依頼では改行等レイアウトがくずれてしまったため回答欄に記載させていただきます。）

変換仕様が不明な部分があるため、幾つか補足をお願いしたいです。

①元データ(CSV)は、例では１人につき１明細ずつしか記載されていませんが、識別種類が混在する人もいるのでは？

（予想）※一部割愛
人名 識別種類 2015/7/1 2015/7/2 2015/7/3 2015/7/4 2015/7/5 2015/7/6 ・・・
K4 a 9:00 14:00 10:00 9:00 14:00 10:00
K2 b 10:00 15:00 22:00 10:00 15:00 22:00
K3 c 1 6
☆K3 a 10:00 10:00 20:00
K1 a 10:00 10:00 20:00
☆K1 c 3 6

②元データにはそれぞれの人に7/1～7/3の時間が記載されていますが、作成結果では一人につき１日分ずつ(例えばK1なら7/1のみ)しか出力されていません。
⇒ 単に割愛しただけ？ 人によって何日分を出力する、といったルールがありますか？

（予想）※一部割愛
K1 2015/7/1 × 10：00
☆K1 2015/7/2 × 10：00
☆K1 2015/7/3 × 20：00
☆K2 2015/7/1 × 10：00
K2 2015/7/2 × 15：00
☆K2 2015/7/3 × 22：00
☆K3 2015/7/1 ×
K3 2015/7/2 ○
☆K3 2015/7/3 ×
☆K4 2015/7/1 × 9：00
K4 2015/7/2 × 14：00
☆K4 2015/7/3 × 15：00

③前日c有無は、前日がcなら○、cでなければ×と推測しますが、データ内の初日はどう判定しますか？
（例では7/1は6/30データがないと判定できない）

なお、データ修正していただいているようですが、まだ不一致の箇所(K2/K4の出力時間)もあるようです。
ちょっと混乱されているのかも？
もう一度、元データの形から出力結果の形に変えるためのルールを洗い出して整理してみてください。

ルールさえはっきりすれば実現可否や方法等アドバイスできると思いますので、よろしくお願いします。

---

【補足を受けての追記】

大きく分けて２つの処理が必要になると思います。
①元データを読み込みソートする
②出力レイアウトの形に変更する

①ソートの処理にはいくつか方法があります。
例ではExcelシートに出力してExcel機能でソートしていますが、作業用シートを使いたくない場合などはADOを利用する方法などもあります。

    '--定数宣言--
    Enum W_ROWS
        Title = 1    'タイトル行
        DataStart    'データ開始行
    End Enum
    
    Enum W_COLS      'ソート用作業シートの列（取得CSVの項目順）
        Name = 1     '名前
        Kubun        '識別区分
        DateSart     '日付の先頭列
    End Enum
    
    Enum O_COLS      '出力シートの列
        Name = 1     '名前
        Date         '日付
        C            '前日c判定
        TIME_A       'aの時間
        TIME_B       'bの時間
        LAST         '最終列判定用
    End Enum

    '--①CSVファイルの読み込み・ソート--
    wsWorkSheet = WorkSheets("Sheet1")
    wsWorkSheet.Activate
    
    iFree = FreeFile '空き番号を取得
    Open "CSVファイル名" For Input As iFree 'CSVファイル(元データ)をオープン
    
    lRow = 0
    Do Until EOF(iFree)
        '1行読み込み
        Line Input #iFree, strLine 
        lRow = lRow + 1
        
        'カンマ区切りで項目ごとに分割して配列に格納
        Dim strSplit() As String
        strSplit = Split(strLine, ",")
        
        '分割した各項目を作業用シートに配置
        Range(Cells(lRow, 1), Cells(lRow, UBound(strSplit) + 1)) = strSplit
        
        '先頭行の場合、列数を保管
        If lRow = 1 Then
            lColMax = UBound(strSplit) + 1
        End If
    Loop
    
    Close #iFree
    
    lRowMax = lRow
    
    'EXCEL機能でソート
    If lRowMax > 0 Then
        'ソート（見出し行は含めず、２行目からソート）
        wsWorkSheet.Range(Cells(W_ROWS.DataStart, 1), Cells(lRowMax, lColMax)) _
                .Sort Key1:=wsWorkSheet.Cells(W_ROWS.DataStart, W_COLS.Name), order1:=xlAscending, _
                      Key2:=wsWorkSheet.Cells(W_ROWS.DataStart, W_COLS.Kubun), order2:=xlAscending
    End If

②レイアウト変更は①でソートした結果行を１行ずつ読み、１つ前の行と比較して前日ｃの判定を行いながら目的の形になるようセルに配置します。
（前日ｃ判定はexcel関数でもできそうですが、今回はVBAでの質問のためVBA内で判定しています。）

    '--②レイアウト変更--
    wsOutputSheet = WorkSheets("Sheet2")
    wsOutputSheet.Activate
    
    lWRow = 0
    lWRowCnt = 0
    strKEY = ""
    strC = "×"
    
    With wsOutputSheet
        '見出し作成
        lWRow = 1
        lWRowCnt = 1
        Range(Cells(lWRow, 1), Cells(lWRow, O_COLS.LAST)) = Split("名称,日付,前回c有無,a,b",",")
        
        '作業用シートのデータ行をループ
        For lRRow = W_ROWS.DataStart To lRowMax
            'ブレイク判定
            If strKEY <> wsWorkSheet.Cells(lRRow, W_COLS.Name) Then
                '前行までと人が変わっていたら・・・
                lWRow = lWRow + lWRowCnt                  '新しい人の開始行
                lWRowCnt = lColMax - W_COLS.DateSart + 1  '新しい人の出力行数(日数)
                
                strC = "×"  '前回cを初期化　⇒"×"
                
                '作業シートの日付列をループ処理
                For lRCol = W_COLS.DateSart To lColMax
                    '新しい人の名称・日付・前回ｃ(初期値)を出力
                    
                Next
            End If
            
            '作業用シートの日付列をループ
            For lRCol = W_COLS.DateSart To lColMax
                '識別種類で出力先を分岐
                Select Case wsWorkSheet.Cells(lRRow, W_COLS.Kubun)
                '  aの場合：aの列(O_COLS.TIME_A)に時間を出力
                '  bの場合：bの列(O_COLS.TIME_B)に時間を出力
                '  cの場合：cの列(O_COLS.C)に前回c判定を出力
                '           その後、次行でセットする前回Cを準備　⇒　今回行に値があれば"○"、なければ"×"
                End Select
            Next
        Next
    End With

長くなってしまったため一部簡略化していますが頑張ってみてください。

Comments

[ian_is_dj]

jawa様 ①おっしゃる通りです。1人につき複数記載されております ②全て1日単位で管理しており、1人につき各識別種類を1日一つ分ずつ記載しております複数はございません ③おっしゃる通り、初日はデータが無いため判定できません。そのため1日目は×で進めようと思っております。 たびたび申し訳ございません。宜しくお願い致します。