人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

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

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

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

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


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

宜しくお願いします!

●質問者: bababa
●カテゴリ:コンピュータ インターネット
✍キーワード:Excel ToDo シフト テキスト リスト
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● oojiji
●20ポイント

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

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

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

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

◎質問者からの返答

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

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

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


2 ●
●20ポイント

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

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

そのブックを開いた状態でさらにシフト表を開き、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


3 ● oojiji
●20ポイント

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

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

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


4 ● kaiton
●20ポイント

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

シフト表が、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

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


5 ● Mug
●20ポイント

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

※できれば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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ