excelを使った、シフト表の加工についての相談です。


縦軸に担当者、横軸に日付を置いて
出勤日に印をつけていく一般的なシフト表を元に、
自動で別のリストを出力したいと考えています。

日付毎に、その日に出勤する担当者を箇条書き的に見やすく出力したいのです。

▼詳しくは図解をごらん頂ければと思います。
http://www.megurogawa.sakura.ne.jp/hatena0923.gif

目的は、出勤者情報をその日のToDoリストの中に入れるためです。

表だとデカすぎて並べられないので、
【その日の出勤者を2行のテキストに収めたい】わけです。


目的を果たせるならば、特に上記画像の体裁にはこだわりません。
※シフト表本体は既にあるものを使わなければなりませんが。

宜しくお願いします!

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2006/09/23 19:37:30
  • 終了:2006/09/30 19:40:02

回答(5件)

id:oojiji No.1

oojiji回答回数38ベストアンサー獲得回数02006/09/24 00:02:55

ポイント20pt

http://www.tekipaki.jp/~oojiji/

マクロを組めば大概のことは出来るのですが、この場合はピボットテーブルで間に合うと思います。

メニューの「データ」のところに機能がありますので、一度試しに作ってみればだいたい理解できるかと思います。もちろんヘルプも参照してみてください。

それでも、思ったような物にならないとお考えでしたら、マクロで組んでみますが、一度おためしください。

id:ssakamoto

うーんすいません、いまピボットテーブルをしばらく試してみましたが(関連情報も幾つか調べました)、「日付ごとに複数の担当者名を出力」ということがどうしても出来ませんでした。

日付ごとに担当者の人数は出せるんですけど。

私が勘違いしているのかもしれませんが、恐縮ですがマクロを含め再度ご教示いただけませんでしょうか。

2006/09/24 01:47:58
id:bonlife No.2

回答回数421ベストアンサー獲得回数752006/09/24 02:11:26

ポイント20pt

以下のようなマクロでいかがでしょうか。

このマクロを標準モジュールとしてあるワークブックに保存しておきます。

そのブックを開いた状態でさらにシフト表を開き、Alt+8でマクロメニューを表示して、保存しておいたマクロを実行します。

シフト表と同じフォルダに"シフト表(日別)_YYYY年MM月分.xls"という名前のファイルを生成するようにしております。

このあたりは気に入らなければ適当に変えてください。

Sub Macro1()

    ' マクロ実行時に開いているブックを対象ブックとして変数に保存
    Set targetBook = ActiveWorkbook
    ' 結果保存用にブックを新規作成、変数に保存
    Set resultBook = Workbooks.Add
    
    ' 対象ブックをアクティブにする
    targetBook.Activate
    filepath = targetBook.Path

    ' 基本となるセルの位置を特定
    ' "担当者"という値を検索し、そのセルの行番号、列番号を取得
    Dim findResult As Range
    Set findResult = Cells.Find(What:="担当者")
    If findResult Is Nothing Then
        MsgBox ("「担当者」という値が見つかりませんでした。 ")
        resultBook.Close
        Exit Sub
    Else
        findResult.Activate
        rowNum = ActiveCell.Row                 ' 行番号
        colNum = ActiveCell.Column              ' 列番号
        lastRowNum = Selection.End(xlDown).Row  ' 対象ブックの最終行の行番号
        personCol = colNum                      ' 人名の列を記憶
    End If

    newRowNum = 1 ' 検索結果用の行番号
    newColNum = 3 ' 検索結果用の列番号 (名前を貼り付けるのは3列目から)

    Dim targetDate, targetYear, targetMonth As String
    targetDate = Cells(rowNum, colNum + 1).Value
    targetYear = Format(targetDate, "YYYY")
    targetMonth = Format(targetDate, "MM")
    Dim i As Integer
    i = 0
    ' 対象ブックの日時の行の値が空になるまで処理を実行
    While Cells(rowNum, colNum + 1).Value <> ""
        ' 日時の値を変数targetDateに保存
        targetDate = Cells(rowNum, colNum + 1).Value
        ' targetDateを結果ブックの1シート目に1つ飛ばしで貼り付け
        resultBook.Worksheets(1).Cells(newRowNum * 2 - 1, 1).Value = targetDate
        ' targetDateを保存した右隣のセルの値を"レジ"にする
        resultBook.Worksheets(1).Cells(newRowNum * 2 - 1, 2).Value = "レジ"
        ' 値を"レジ"にしたセルの1つ下のセルの値を"事務"にする
        resultBook.Worksheets(1).Cells(newRowNum * 2, 2).Value = "事務"
        ' 対象ブックの日付の次の行、人名の次の列から処理を行う
        ' 特定の日付のセルを全てに対して、"レジ"キーワードで検索する
        With Range(Cells(rowNum + 1, colNum + 1), Cells(lastRowNum, colNum + 1))
            Set c = .Find("レジ", LookIn:=xlValues, After:=Cells(lastRowNum, colNum + 1))
            If Not c Is Nothing Then
                ' 1つ目の検索結果を記憶しておく
                firstAddress = c.Address
                Do
                    ' "レジ"が見つかったセルに対応する人名を結果セルに保存
                    resultBook.Worksheets(1).Cells(newRowNum * 2 - 1, newColNum).Value = Cells(c.Row, personCol).Value
                    newColNum = newColNum + 1
                    Set c = .FindNext(c)
                ' 1つ目の検索結果と同じでない間、上記の処理を繰り返し
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        newColNum = 3
        ' 特定の日付のセルを全てに対して、"事務"キーワードで検索する
        With Range(Cells(rowNum + 1, colNum + 1), Cells(lastRowNum, colNum + 1))
            Set c = .Find("事務", LookIn:=xlValues, After:=Cells(lastRowNum, colNum + 1))
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    resultBook.Worksheets(1).Cells(newRowNum * 2, newColNum).Value = Cells(c.Row, personCol).Value
                    newColNum = newColNum + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        newColNum = 3
        newRowNum = newRowNum + 1
        colNum = colNum + 1
    Wend
    

    resultBook.Activate
    ' 日付の書式変更
    Columns("A:A").Select
    Selection.NumberFormatLocal = "m""月""d""日"";@"
    ' 1行目、2行目のみセンタリング
    Columns("A:B").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    ' 罫線の設定 (縦線のみ)
    Selection.CurrentRegion.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlInsideVertical)
        .Weight = xlThin
    End With

    ' 日付部分の罫線、色変更
    newRowNum = 1
    While Cells(newRowNum, 1).Value <> ""
        Range(Cells(newRowNum, 1), Cells(newRowNum + 1, 1)).Select
        With Selection.Borders(xlEdgeLeft)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeTop)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .Weight = xlMedium
        End With
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        With Selection.Interior
            .ColorIndex = 44
            .PatternColorIndex = xlAutomatic
        End With
        newRowNum = newRowNum + 2
    Wend
   
    ' 2列目の罫線、色変更
    newRowNum = 1
    While Cells(newRowNum, 2).Value <> ""
        Range(Cells(newRowNum, 2), Cells(newRowNum + 1, 2)).Select
        With Selection.Borders(xlEdgeLeft)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeTop)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlInsideHorizontal)
            .Weight = xlHairline
        End With
        With Selection.Interior
            .ColorIndex = 36
            .PatternColorIndex = xlAutomatic
        End With
    newRowNum = newRowNum + 2
    Wend

    ' 3列目以降の罫線設定
    newRowNum = 1
    While Cells(newRowNum, 2).Value <> ""
        Range(Cells(newRowNum, 3), Cells(newRowNum + 1, ActiveCell.SpecialCells(xlLastCell).Column)).Select
        With Selection.Borders(xlEdgeLeft)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeTop)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .Weight = xlMedium
        End With
        With Selection.Borders(xlInsideHorizontal)
            .Weight = xlHairline
        End With
    newRowNum = newRowNum + 2
    Wend

    Cells(1, 1).Select
    ' 検索結果ブックに名前をつけて保存 (同名のファイルがあった場合、強制的に上書き)
    Dim resultBookFileNmae As String
    resultBookFileName = "シフト表(日別)_" &amp; targetYear &amp; "年" &amp; targetMonth &amp; "月分.xls"
    Dim wb As Workbook
    ' 保存しようとしている名前のファイルをすでに開いている場合、閉じる
    For Each wb In Workbooks
        If wb.Name = resultBookFileName Then
            wb.Close
        End If
    Next wb
    ' 上書き保存時にアラートを表示させない
    Application.DisplayAlerts = False
    resultBook.SaveAs Filename:=filepath &amp; "\" &amp; resultBookFileName
    Application.DisplayAlerts = True
End Sub

セルの色の指定をColorIndexで行ってしまっているので、環境によって表示のされ方が異なるかもしれません。

他にも上手く動かない点があればご指摘ください。

時間がある時に修正いたします。

参考になれば幸いです。

参考URL

id:oojiji No.3

oojiji回答回数38ベストアンサー獲得回数02006/09/24 08:20:26

ポイント20pt

http://www.tekipaki.jp/~oojiji/

実際ピボットテーブルで試してみましたが確かに難しいですね。文字データを表示させるのは、表示データの種類で最大値とかを選択すれば出てくるのですが、複数出す場合は対応出来ませんでした。もう少し簡単に出来ると勘違いしておりました。申し訳ありません。

マクロを組んで提示しようと思いましたところ、bonlife 氏が既に回答されておりますので、私の方は控えさせて頂きたいと思います。

id:kaiton No.4

kaiton回答回数260ベストアンサー獲得回数342006/09/24 10:23:43

ポイント20pt

関数だけを使った方法です。

シフト表が、Sheet1のA1から始まっているとします。

この関数の範囲は、1週間×10人分を想定していますので、適宜範囲は広げたり調整してください。


Sheet2に「レジ」用の表を作成

A1=レジ

B1=Sheet1!B1 横に日付分だけコピー

A2=Sheet1!A2 下に人数分だけコピー

B2=IF(Sheet1!B2=Sheet2!$A$1,ROW(),"") これを縦横にコピー

レジの人一覧(縦方向)作成

B21=IF(ISERROR(SMALL(B$2:B$11,ROW()-20)),"",INDEX($A$1,SMALL(B$2:B$11,ROW()-20)))

この数式を縦横に日付・人数分コピー

ここで、「レジ」の人一覧が縦に並んでできているはず


Sheet3に「事務」用の表を作成

A1=レジ

B2=IF(Sheet1!B2=Sheet3!$A$1,ROW(),"") これを縦横にコピー

以外はSheet2と同じ


Sheet4に最終的な表を

A2=OFFSET(Sheet1!$B$1,0,INT(ROW()/2)-1) これを下にコピー

B列2行目から、「レジ」「事務」を下に繰り返し

C2=INDEX(Sheet2!$B$21:$H$30,COLUMN()-2,INT(ROW()/2))

C3=INDEX(Sheet3!$B$21:$H$30,COLUMN()-2,INT(ROW()/2))

この2個のセルを横、縦にコピーしてみてください。


注意)

数式中でつかっている

行を表すROW関数、列を表すCOLUMN関数は、表の位置が変わると、調整が必要です。

「COLUMN()-2」や「INT(ROW()/2)」の部分

配列数式あたりを使うとなくすることもできるかもしれませんが、重くなりそうなので止めました。


なるべく、シンプルな関数だけを使おうと思ったので..数式が長いし...Sheet4の内容は、Sheet1の下の方にもってくることはできます。

その際は「COLUMN()-2」や「INT(ROW()/2)」の部分を調整してみてください。


あと、数式は別のPCで作成して、この回答はタイプしたので..タイプミスがあるかもしれません。m(__)m


つかっている関数は

http://www.eurus.dti.ne.jp/yoneyama/Excel/kansu/itiran.html

が使用例があるので、わかりやすいかと思います。

id:Mug No.5

Mug回答回数15ベストアンサー獲得回数32006/09/24 16:36:55

ポイント20pt

全て関数でマクロを使わずにやってみました。

※できればR1C1参照形式の方が、同じ意味の数式が同じ数式になるので、投入のときだけでも変更するとよいかも知れません。(A1形式を常用しているなら戻すのを忘れずに)

※上記GIFのEXCELに加工する手順です。A1(R1C1)のセルに「担当者」と入っている想定です。

◆R1C1形式での場合

※R1C1参照形式かA1参照形式かは、ツール→オプション→全般タブ→左上のチェックボックスで変更可能。

1.箇条書き欄の日付の下、つまりR19C2,R21C2,R23C2…に以下の数式を投入。

="C"&MATCH(R[-1]C2,R1,0)&":R"&(ROW(R1C1)+ROWS(R2C1:R13C1))&"C"&MATCH(R[-1]C2,R1,0)

2.箇条書き欄の担当者のセルに以下の数式を投入

=IF(COUNTIF(INDIRECT("R"&(ROW(R1C1)+1)&IF(ISNUMBER(RC2),R[1]C2,RC2),0),RC3)>=(COLUMN(RC)-COLUMN(RC3)),INDIRECT("R"&(ROW(R1C1)+IF((COLUMN(RC)-COLUMN(RC3))>1,MATCH(RC[-1],R2C1:R13C1,0),0)+MATCH(RC3,INDIRECT("R"&(ROW(R1C1)+IF((COLUMN(RC)-COLUMN(RC3))>1,MATCH(RC[-1],R2C1:R13C1,0),0)+1)&IF(ISNUMBER(RC2),R[1]C2,RC2),0),0))&"C"&COLUMN(R1C1),0),"")

◆A1形式の場合

1.箇条書き欄の最初の日付の下、つまりB19に以下の数式を投入。

="C"&MATCH($B18,$1:$1,0)&":R"&(ROW($A$1)+ROWS($A$2:$A$13))&"C"&MATCH($B18,$1:$1,0)

2.B19をB21,B23…にセルのコピー。

3.箇条書き欄の左上の担当者セル、つまりD18に以下の数式を投入。

=IF(COUNTIF(INDIRECT("R"&(ROW($A$1)+1)&IF(ISNUMBER($B18),$B19,$B18),0),$C18)>=(COLUMN(D18)-COLUMN($C18)),INDIRECT("R"&(ROW($A$1)+IF((COLUMN(D18)-COLUMN($C18))>1,MATCH(C18,$A$2:$A$13,0),0)+MATCH($C18,INDIRECT("R"&(ROW($A$1)+IF((COLUMN(D18)-COLUMN($C18))>1,MATCH(C18,$A$2:$A$13,0),0)+1)&IF(ISNUMBER($B18),$B19,$B18),0),0))&"C"&COLUMN($A$1),0),"")

4.D18を担当者欄の全てのセルにコピー

◆利点

・マクロを使わないので、マクロのセキュリティに関係ない。

・上側のシフト割り当て表を変更するとリアルタイムに反映される。

・日付は右側にどこまででも増やせます。

◆欠点(制約)

・シフト割り当て表の担当者を増やすときは、端に増やすことができない。つまり、GIFの川口の上や阿部の下には増やせません。数式の参照先がずれるので、端にならないように行の挿入をしてください。

・EXCELのファイルを開き、何も変更せずに閉じようとしても、「変更を保存しますか?」と聞かれる。(実質的に変更していなければ保存不要。)これはINDIRECTという関数を使用しているため。(ポインタみたいな関数です)

http://q.hatena.ne.jp/1159007847

  • id:taknt
    マクロを使えば簡単
  • id:ssakamoto
    そのマクロについて教えて欲しいですー
  • id:bonlife
    今気づいたのですが、私の回答の下部に数箇所ある&amp;は全て&です。
    このあたりでエラーが出てしまっているかもしれないですね。
    標準モジュールの追加方法はメニューバーの[ツール(T)]-[マクロ(M)]-[Visual Basic Editor(V)]でMicrosoft Visual Basicの画面を開き、[挿入(I)]-[標準モジュール(M)]としてModule1を挿入します。
    この画面に、上記のコードをコピーすると一部赤い文字で表示される部分があります。
    そこが問題がある部分ですので、&amp;を&に修正してください。

    参考になれば幸いです。
  • id:kaiton
    誤解を受けるかもしれないので、補足します。
    >行を表すROW関数、列を表すCOLUMN関数は、表の位置が変わると、調整が必要です。
    ROW関数、COLUMN関数を使うのは
    例えば、 =INDEX(Sheet2!$B$21:$H$30,1,1) の第2,第3引数を、1,2,3...と表の位置によって変化させるためです。
    ROW関数、COLUMN関数がわかりにくいなら、直接1,2,3..とか入れてみてください。
    数式のコピーでこの値が思い通りに変化すれば問題ないのですが、増減しないので、ROW関数、COLUMN関数で計算して数式のコピー後に数式を変更する手間を省いています。

    前に別質問を回答した際も感じましたが、同じ事を実現するにも、いろいろな方法がありますね...
    興味深いし、勉強になります。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません