[[20160917114042]] 『日毎の人の出入りを一覧にしたい』(macky) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『日毎の人の出入りを一覧にしたい』(macky)

初めまして。よろしくお願いいたします。
表題の件ですが、ご教示お願いできませんでしょうか?

次のようなデータがあります。
(9月5日時点)
利用者  入室    退室
Aさん  9月1日      
Bさん  9月1日  9月4日
Cさん  9月2日  9月4日
Dさん  9月5日      

病室の入退院管理票です。
マスタとなるデータにはこれ以上にたくさんの情報を入力してあります。
退室が空欄なのは9月5日時点でまだ利用中という意味です。

このデータを月のレポートとして一月分日毎にまとめたものを出すのですが
正直無駄作業でしかなく、渡したデータって何かに活用してるの?ってレベルです。
そこで何とか無駄を省き自動化させたくご質問させていただきました。
希望するフォーマットは以下のものです。

      入室     退室
9月1日  Aさん
9月2日  Cさん      
9月3日
9月4日         Bさん
             Cさん
9月5日  Dさん

入りと出は日によっては5人とかになることもあり
複数データを抽出する、しかも日毎にとなると意味が分からなくなってきました。
どうかお助けください。よろしくお願いします。

< 使用 Excel:Excel2016、使用 OS:Windows7 >


 元シートですが1行目がタイトル行ですか?
 それとも、1行目は (●日時点)といったコメントがあって、タイトルは2行目ですか?

 あと、この処理方式ですが、関数処理、エクセル手作業操作、マクロ処理、どれを考えておられますか?

(β) 2016/09/17(土) 13:18


早速のご返信ありがとうございます。

タイトル行に関してですが
利用者から始まる行になります。〜日時点は便宜的なものでした、申しわけありません。

処理方法はVBA、関数問わないんですが、元データと同じものを
再度入力する手間を省きたいです。

確かに元データから手打ちすれば済む話ではあるんですが
いかんせん非効率な職場で
これと同じように元データのフォーマットが変わっただけのものを
何種類も作るという無駄作業をしています。
ほかの物に関しては自分なりにVBAや関数で形を作ったんですが
これだけがよくわからなくて・・・

お手数をかけ申しわけありません。よろしくお願いします。

(macky) 2016/09/17(土) 15:39


 マクロです。シート名、★印のところは実際のものにしてください。
 ちょっと、難解なコードかもしれません。
 ピボット等を活用した、もっと、簡単なものが、他の皆さんからアップされるような気もします。

 Sub Sample()
    Dim fdt As Long
    Dim tdt As Long
    Dim lst As Range
    Dim col As Range
    Dim x As Long
    Dim dicIn As Object
    Dim dicOut As Object
    Dim dic As Object
    Dim d As Long
    Dim i As Long
    Dim n As Long
    Dim c As Range

    Application.ScreenUpdating = False

    Set dicIn = CreateObject("Scripting.Dictionary")
    Set dicOut = CreateObject("Scripting.Dictionary")

    Set lst = Sheets("Sheet1").Range("A1").CurrentRegion    '★元シートの表領域

    With lst.Offset(1, 1).Resize(lst.Rows.Count - 1, 2) 'データ領域
        fdt = WorksheetFunction.Min(.Cells)         '最初の日付(シリアル値)
        tdt = WorksheetFunction.Max(.Cells)         '最後の日付(シリアル値)
        For x = 1 To 2
            If x = 1 Then
                Set dic = dicIn
            Else
                Set dic = dicOut
            End If
            For Each c In .Columns(x).Cells
                If Not IsEmpty(c) Then
                    If Not dic.exists(c.Value2) Then Set dic(c.Value2) = CreateObject("System.Collections.ArrayList")
                    dic(c.Value).Add c.EntireRow.Range("A1").Value
                End If
            Next
        Next
    End With

    With Sheets("Sheet2")   '★展開シート
        .Cells.ClearContents
        i = 2   '転記開始行
        .Range("B1:C1").Value = Array("入出", "退出")
        For d = fdt To tdt
            .Cells(i, "A").Value = d
            If dicIn.exists(d) Then
                If dicOut.exists(d) Then
                    .Cells(i, "B").Resize(dicIn(d).Count).Value = WorksheetFunction.Transpose(dicIn(d).toarray)
                    .Cells(i, "C").Resize(dicOut(d).Count).Value = WorksheetFunction.Transpose(dicOut(d).toarray)
                    i = i + WorksheetFunction.Max(dicIn(d).Count, dicOut(d).Count)
                Else
                    .Cells(i, "B").Resize(dicIn(d).Count).Value = WorksheetFunction.Transpose(dicIn(d).toarray)
                    i = i + dicIn(d).Count
                End If
            ElseIf dicOut.exists(d) Then
                .Cells(i, "C").Resize(dicOut(d).Count).Value = WorksheetFunction.Transpose(dicOut(d).toarray)
                i = i + dicOut(d).Count
            Else
                i = i + 1
            End If
        Next
        .Columns("A").NumberFormatLocal = "m""月""d""日"""
        .Select
    End With

 End Sub

(β) 2016/09/17(土) 22:11


 こんばんわ。

 纏めたデータを配布するんですよね、なら関数よりマクロの方が良いと思います。
 βさんからコードアップされてたので、もしご自身で勉強の為にトライされると言うなら、こんな感じかなとくらいに捉えて下さい。

 元データに無い日付も表示させるみたいなので、

 ループで日付を1日づつ加算して、COUNTIFで入室と退出で多い方の数分だけ日付を順にセット。

 元データの入室・退出を上から順番に検索して、同じ日付の患者名を変数に格納、Matchで見つかった日付の氏名欄に出力。

 こんな感じでしょうか。

(sy) 2016/09/17(土) 22:17


おはようございます。
早速ですがコード入力して試してみました。

ただ一言、凄まじいです。
あの無駄作業がワンクリックで終わってしまうなんて・・・
エクセルの無限の可能性を垣間見ました。
βさん本当にありがとうございます。

これから一行一行コードの動作を調べて自分の力にし、
今後はお手を煩わせる事のないよう精進します。

syさんご説明ありがとうございます。
どのような考え方で処理していけばいいか、それが解りませんでした。

コンピューター処理特有の手順
これがどうにも上手く捉えられません。
でもやればやるほど面白くてこんな苦にならない勉強は始めてです。
今更ながら職業選択を間違った気がします(笑

お二人とも本当にありがとうございました。

(macky) 2016/09/18(日) 08:11


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.