[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAを使ったシフト作成をしたい』（りら）
訪問介護のシフトを作成したいのですが、行き詰っています。
excel2010,Windows7
sheet1
A B C D
1 名前 スキル
2 身体介護 生活援助 予防訪問
3 helper1 ○ ○
4 helper2 ○ ○ ○
5 helper3 ○
6 helper4 ○ ○
7 helper5 ○ ○
8 helper6 ○ ○
・
・
・
23
sheet2
A1〜A40に利用者名
B1〜B40に担当helper名
C1〜C40にサービス内容（身体介護、生活援助、予防訪問など）
D1〜D40にサービス開始時間
E1〜E40にサービス終了時間
sheet3にシフト表を作成したいと思っています。
ガントチャートみたいな感じで、helperが何時にどこの利用者に行くのかが分かるようにしたいです。
アドバイスでもいいので、作成の仕方を教えていただけませんか？
お願いいたします。
回答じゃないんだけど、Sheet1って、各ヘルパーさんの職掌というか役割？ Helper1さんは、予防訪問は行わない？ で、もし、Sheet2 に 利用者AさんがHelper11さんに予防訪問してもらうと 記入してあったらどうするのかな？
それと、開始、終了時間は「当日中」だよね。逆に言えば、Sheet3の時間軸は24時間が最大だよね？ 時間の単位は？分とか３０分とか１時間とか？
Sheet2に、同じヘルパーさんが、同じ時間帯で、複数の利用者さんにアサインされていたらどうする？
Sheet3がガントチャートみたい・・・ここがシビレルかもしれないけど、この手のエキスパートさんがたくさんおられるので なんとかなるとして、そのSheet3 は イメージとしては縦軸にヘルパーさん、横軸に時刻、で情報としては利用者さん？ なんのために（身体看護 とか 生活援助 とか）は不要？
(ぶらっと)
予防訪問でしたら、どのhelperでもできるかと思います。
書き方が紛らわしくてすみません。
たとえば、helper4は生活援助と予防訪問のスキルを身に付けているとします。
そしたら、利用者Aがhelper4に身体介護を頼んでも、スキルがないので担当できないということです。
開始・終了時刻は当日です。
時間は7:00〜19:00までとします。
時間単位は15分です。
＞ Sheet2に、同じヘルパーさんが、同じ時間帯で、複数の利用者さんにアサインされていたらどうする？
片方はそのhelperが担当し、もう片方は同じスキルを持ったhelperが担当するとします。
sheet3は縦軸にhelper、横軸に時刻
情報として利用者名とできれば、サービス内容も加えたいです。
身体介護でしたら、「身体」だけでも・・・。
細かい指摘ありがとうございます。
なんだかかなり時間が空いてしまってますが まだ見て居られますかね。。。？
Sheet3の表をSheet2のデータから作成すると言う事ですよね？
＞＞ Sheet2に、同じヘルパーさんが、同じ時間帯で、複数の利用者さんにアサインされていたらどうする？ ＞片方はそのhelperが担当し、もう片方は同じスキルを持ったhelperが担当するとします。
と言う事ですが。。。その場合Sheet3にはどの様に表示しておけば良いのでしょう？ VBAでSheet3を実行する迄には、解消されている様な事なのでしょうか？
＞アドバイスでもいいので って事なので、私なら Sheet3の横軸として1列を15分単位にして 塗りつぶしていくと思います。
雑なコードですが一応。。。 データの整合性のチェックは行っていません。実行前に解消しておいて下さい。
Sheet1はA3からヘルパーの名前 Sheet2は2行目からデータ Sheet3は C1セルに 7:00〜 15分刻みで 19:00(AY1)まで時間をふっておいて下さい。 （コード内では使用しませんが。。。） A列はヘルパーの名前（コード内でSheet1から参照します） B,AY,AZ列は時間外が有った場合になんとなく使用します。
'------ Sub lyra1() Dim tbl1 As Variant, tbl2 As Variant, x As Variant Dim dic As Object Dim Str As String, Msg As String Dim Col As Long, Fir As Long, Las As Long Dim i As Long, xr As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
tbl1 = .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("Sheet2")
tbl2 = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("Sheet3")
.Range("2:" & Rows.Count).ClearContents
.Range("2:" & Rows.Count).Interior.ColorIndex = xlNone
ReDim x(1 To UBound(tbl1, 1), 1 To 52)
For i = 1 To UBound(tbl1, 1)
dic(tbl1(i, 1)) = i
x(i, 1) = tbl1(i, 1)
Next
For i = 1 To UBound(tbl2, 1)
If dic.Exists(tbl2(i, 2)) Then
xr = dic(tbl2(i, 2))
Fir = tbl2(i, 4) * 24 * 60 / 15 - 25
Las = tbl2(i, 5) * 24 * 60 / 15 - 25
If Fir < 3 Or 51 < Las Then
Str = tbl2(i, 1) & "," & tbl2(i, 3) & _
Format(tbl2(i, 4), ",h:mm") & Format(tbl2(i, 5), "〜h:mm")
If x(xr, 52) = "" Then
x(xr, 52) = Str
Else
x(xr, 52) = x(xr, 52) & "・" & Str
End If
End If
Fir = Application.Max(2, Fir)
Las = Application.Min(52, Las)
x(xr, Fir) = tbl2(i, 1) & _
IIf(Fir = 2, Format(tbl2(i, 4), ",h:mm"), "") & Format(tbl2(i, 5), "〜h:mm")
Select Case tbl2(i, 3)
Case "身体介護"
Col = 38
Case "生活援助"
Col = 36
Case "予防訪問"
Col = 34
End Select
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
Else
Str = i & "件目・" & tbl2(i, 2)
If Msg = "" Then
Msg = Str
Else
Msg = Msg & vbLf & Str
End If
End If
Next
.Range("A2").Resize(UBound(x, 1), UBound(x, 2)).Value = x
If Msg <> "" Then
MsgBox "未登録者名" & vbLf & Msg
End If
End With
Set dic = Nothing
End Sub
'------
(HANA)
ガンチャートは、私も以前、投稿した事がありました。
ichinose
コードありがとうございます！
今実行しようとしているのですが、インデックスが有効範囲にありません。
と出てきてしまいました；；
実行できるよう頑張ってみます！
（りら）
参考にさせていただきます！
ありがとうございます！
（りら）
のエラーですか。。。
[デバッグ]ボタンを押すと、コード内のどこかの行が黄色く成ると思いますが どの行が黄色く成っていますか？
(HANA)
上記のエラーは解決しました！
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
の部分がエラーになってしまったのですが・・・；；
どうすればいいのでしょうか？
（りら）
エラー内容は同じ「インデックスが有効範囲にありません。」ですか？
ローカルウィンドウを表示させると、それぞれの変数の内容が確認出来るので i,xr,Las,Fir,Col がそれぞれいくつに成っているか、教えて下さい。
それから、入れ忘れていたので
Case "予防訪問"
Col = 34
の下に
Case Else
Col = 3
を入れておいてもらえると良いと思います。
(HANA)
何回もありがとうございます！
上記のエラーもなぜか解決しました
お騒がせしてすみません；
質問があるのですが、このシフトに変更が生じたときに
代わりのヘルパーを探すということもしたいのですが、
それは同じコードに記入しても大丈夫なものですか？
（りら）
何だったんでしょうねぇ。＾＾；
追加のご質問に関しては、どう言った事を想定して居られるのか よく分からないです。。。
「○時〜×時の間で、手が空いている人で、スキルを持っている人を一覧で抽出してきて！！」 なんてコードを作ろうと思って居られるなら 元に成るデータを一回作っておいた方が良いかもしれません。
現状は、今はセルに色を付けるだけで、人が見る事しか想定していませんので。
ただ、その場合でも lyra1のコードとは独立した物に成ると思いますが。。。
(HANA)
シフトに入っているヘルパーの中から代わりのヘルパーを探したいと思っています。
探す条件として、スキルがあるか→変更される時間が空いているか→利用者の家に訪問したことはあるか
という順番で考えています。
変更が生じたときに、ヘルパー同士の利用者への訪問回数が均等になるようにしたいんです。
たとえば、ヘルパーAさんの１か月の利用者訪問回数が２０回だとします。
したらヘルパーAさんはこの２０回を基準に、変更が生じたときに訪問回数が＋１やー１になったりします。
これがマイナスのヘルパーから、代わりのヘルパーを探すようにしたいんですけど
可能でしょうか？
何度もすみません；；回答お待ちしてます！
（りら）
VBAでやるのに 可能か、不可能か と聞かれるなら 可能だと思います。 後は・・・やる気が有るか無いか。。。と言うと語弊が有るかも知れませんので やる価値が有るか無いか？
細かい事（避けて通れない事ですが）を考えると Sheet3を見ながら人がやるのが確実だと思います。
Sheet3に 持っているスキルの情報 当日働けるか否かの情報 既定訪問回数と予定訪問回数の差 の3つが入る様にしておけば、オートフィルタで絞り込みながら 代わりの人を捜すのは そんなに大変では無いと思います。
代わりの人が居なかった場合、 その人にどうしてもやってもらうのか、それとも他の人を組み替えるのか。。。 代わりの人が複数見つかった場合、どちらの人にやってもらうのか。。。 等、様々な判断も必要に成ってくると思います。
(HANA)
いつもありがとうございます！
人がやるのが確実だとは思いますが、
人がやった場合とプログラムで変更可能なヘルパーを探し出す場合とを比較したいのです。
代わりの人がいなかった場合、変更希望時間の前後に入っている利用者さんの利用時間をずらして、
変更の出た利用者さんをいれるという方法も考えています。
代わりの人が複数見つかった場合は、マイナスの大きいヘルパーを入れたいと思っています。
（りら）
＞人がやった場合とプログラムで変更可能なヘルパーを探し出す場合とを比較したいのです。 結果を比較するのですか？ 結果を得るまでの時間を比較するのですか？
時間を比較する場合 その比較の中には「プログラムを作る時間」とか 「作る為に必要なスキルを身につける時間」とかも含まれていますよね？
結果に関しては、何処まで作り込むか ってのに非常に左右されると思います。
取り敢えず、一般機能も利用しながら作っていくと 有る程度の事は簡単に出来ると思いますので、書いてみます。
Sheet3で時間帯に色を付けましたが、VBAで確認しやすくなる様に 色ではなく、フラグを立てる様にして下さい。 訪問時間帯（色が付く範囲）は「1」。それ以外は「0」
AZ列までこの表で使うので、 BA列にシフト・・・・その日動ける人に「○」等 BB列に日数の差 BC列以降に 持っているスキル 名前をSheet1からコピーしているので スキル部分もSheet1からコピーしてもらえれば良いと思います。
これらを、Sheet4に作成して下さい。
この表からフィルタの詳細設定で絞り込んで行きますので Sheet4の1行目は、全てのセルを見出しで埋めて下さい。
抽出条件としては 見出し部分は全てコピーしてもらえれば良いと思います その時間帯に空いている人を捜すので、対応する時間帯に「0」を入れます シフトに入っている人が抽出対象なので「○」を指定 必要なスキルにも「○」を指定
で、抽出すると該当者だけが抽出されるので BB列で昇順に並べ替えると マイナスの大きい人から順に並びます。
前半部分は、lyra1を改造して作れると思います。 フィルタの詳細設定で抽出するコードは、マクロの記録で出来ると思います。 昇順に並べ替え部分も記録で出来ますが、2003迄の記録と少し変わって仕舞いましたので VBAのソートのページを確認して貰った方が良いかもしれません。
抽出条件を設定する部分の ＞その時間帯に空いている人を捜すので、対応する時間帯に「0」を入れます ここは、lyra1の時間帯を特定する部分を参照してもらえると良いと思います。 前半部分は、指定時間と時間帯の重複部分に「1」、それ以外に「0」を入れますが ここでは、指定時間（空いている人を捜す時間）と時間帯の重複部分に「0」を入れる事に成ります。
イメージとしては、以下の様な感じです。 [A] [B] [C] [D] [E] [F] [G] [H] [I] [J] [K] [L] [1] スタッフ 8:00 9:00 10:00 11:00 12:00 13:00 シフト 日数差 身体介護 生活援助 予防訪問 [2] helper1 0 0 0 0 0 0 0 ○ ○ [3] helper2 0 1 1 0 0 0 ○ -1 ○ [4] helper3 0 0 0 0 0 0 -2 ○ ○ [5] helper4 1 0 0 0 0 0 ○ 2 ○ ○ ○ [6] helper5 0 0 0 1 1 0 ○ 0 ○ [7] helper6 0 0 0 0 0 0 0 ○ [8] [9] [10] スタッフ 8:00 9:00 10:00 11:00 12:00 13:00 シフト 日数差 身体介護 生活援助 予防訪問 [11] 0 0 ○ ○ [12] [13] [14] スタッフ 8:00 9:00 10:00 11:00 12:00 13:00 シフト 日数差 身体介護 生活援助 予防訪問 [15] helper2 0 1 1 0 0 0 ○ -1 ○ [16] helper4 1 0 0 0 0 0 ○ 2 ○ ○ ○ [17]
2〜7行目に関して Sheet1の内容から、A2:A7,J2:L7 Sheet2の内容から、B2:G7 シフト表から、H2:H7 ？？？から、I2:I7
10行目は、1行目のコピー
11行目は シフトに入っている人で・・・H11に「○」 生活援助のスキルの有る人で・・・K11に「○」 11:00〜13:00に空いている人・・・E11:F11に「0」 を探す時のサンプルです。
14行目以降が、抽出結果です。 抽出後、I列で並べ替えを行います。
これだけの作業でも、VBAが出来てしまえば瞬く間に「helper2」と言う結果を得られると思いますが そのVBAを作るのは、瞬く間 と言う訳にはいかないと思います。
いくつか段階が有りますので、 コード化出来そうな所から 初めてみてもらえると良いと思います。
(HANA)
無駄の無い様に、コード化に着手する前に 同じ作業をご自身で行い、結果の精度を確認して貰うのが良いと思います。
時間を掛けてコードを作ったが、ロジックが悪くて思った結果が出ない なんて事に成ると 得る物が非常に少ないので。
また、色々なパターンで試してもらえると コードにする際に 注意する点等も見つかるかも知れません。
(HANA)
毎回ありがとうございます！
＞結果を比較するのですか？
結果を得るまでの時間を比較するのですか？
シフト変更が生じてから、シフト管理者がシフト変更するまでの時間を比較しようと思っています。
その比較の中に「プログラムを作る時間」とか
「作る為に必要なスキルを身につける時間」とかは含まれていません。
抽出条件前までは何となくですが、自分なりにやってみました！
ただ、その日動ける人に○をつける部分ですが、どのように書けばいいのでしょうか？
あと、訪問回数のプラスマイナスは、手入力になってしまいますか？
イメージも私が考えるものにとても近いです！
本当にありがとうございます！！
（りら）
「効率」って事を考えると、両方合わせた時間を考えないといけないですよね。 開発する時間＋それを使った運用にかかる時間の累計 と 出来たVBAが使える間手作業でやった時間の累計 を考えて 日々の作業が面倒でも、後者の方が時間が短くて済むのなら 開発せずに、差分の時間を他のことに使った方が賢いです。
＞その日動ける人に○をつける部分ですが、どのように書けばいいのでしょうか？ ＞訪問回数のプラスマイナスは、手入力になってしまいますか？ りらさんが手作業でするならどの様にしておきますか？
これらに関しては、私は何の情報も持っていないので 何とも言えません。
その日（？）に誰がシフトに入っているのか、一覧が有りそうに思いますが？ その人の既定訪問回数が何回なのか、決められていると思いますが？ その期間内に何回訪問するのかは、どこかをカウントするのではないかと思いますが？
まずはそちらの状況を ご説明頂くのが良いと思います。
今更ですが、この掲示板 空行を挟まないと、改行しても続けて表示されて仕舞いますよね？ _←ここに半角スペースを入れて書き始めて下さい。 空行を挟まなくても 思った所で改行して表示される様に成りますので。
(HANA)
書き方教えていただいてありがとうございます！ 改行できないので、空行入れてました^^;
＞りらさんが手作業でするならどの様にしておきますか？ 手作業なら、シフト表からシフトに入っているヘルパーを判断します。 訪問回数は、変更が生じたたびに移動したシフトでプラスマイナスします。
ヘルパーの訪問回数は１か月のシフト作成時点で決まります。 そこから変更が生じてしまいますので、 訪問回数がシフト作成時から１回増えるヘルパーもいれば、 １回減ってしまうヘルパーもいるというわけです。
考えてみましたが、訪問回数はシフト管理者が変更するヘルパーを選ぶので リストボックスみたいなかんじであらかじめプラスマイナスをいくつか作っておこうかと思います。
そこからシフト管理者がプラスマイナスを操作するという・・・
(りら)
＞手作業なら、シフト表からシフトに入っているヘルパーを判断します。 でしたら、↑の小さなサンプルでのセル番地で言うと B2:G7に「1」を入れるのと同時にH2:H7にも「1」を入れることにして H11に「1」を指定して抽出する と言う事でも良いのでしょうか？
シフトに入る事は出来るが、諸般の事情でSheet2に名前が無かった なんて事はあり得ないのでしょうか？
＞ヘルパーの訪問回数は１か月のシフト作成時点で決まります。 この辺りが良く分からないのですが Sheet2に 10日 のシフトが作成して有るとしますよね？ 11日のシフトは何処に作成されているのでしょう？
同じブックには無い様な感じも有りますし 同じブックに有る様な感じもしますし。。。
同じブックに有るのなら 各シートの決まった位置で COUNTIF関数で その日の訪問回数を数え 串刺し計算すると、その月の訪問回数が計算出来ます。
たとえば、各日のシートのG:H列に件数を数える式。 Sheet1のE列に串刺し計算する式を入れておく。
一か月のシフトを作成した時点で、E列をコピーして F列に値貼り付け。 G列には E列-F列 の計算式。
I2:I7には、このG列の値を参照。
シフト変更で代わりの人を見つけ、Sheet2のデータを変更したら 連動してSheet1のF列の値＝Sheet4のI列の値が変わる様に成ると思います。
(HANA)
串刺し計算の所の簡単なイメージを書いてみます。 Sheet1 [A] [B] Sheet2 [A] [B] [C] [D] [1] 品名 個数 [1] 品名 品名 個数 [2] りんご 1 [2] ばなな りんご 0 [3] ばなな 2 [3] いちご ばなな 1 [4] みかん 2 [4] みかん 0 [5] いちご 1 [5] いちご 1 [6] [6]
Sheet3 [A] [B] [C] [D] Sheet4 [A] [B] [C] [D] [1] 品名 品名 個数 [1] 品名 品名 個数 [2] りんご りんご 1 [2] みかん りんご 0 [3] ばなな ばなな 1 [3] ばなな 0 [4] みかん みかん 1 [4] みかん 1 [5] いちご 0 [5] いちご 0 [6] [6]
Sheet1のB列と、Sheet2〜Sheet4のD列に数式を入れます。 Sheet2〜Sheet4のA列がデータを入力する列で その他の部分は定数（変動しない部分）になります。 Sheet1のA列を変更した場合Sheet2〜Sheet4のC列も変わって欲しいので 「=」で参照させておいても良いと思いますが。
Sheet2〜Sheet4の D列は、=COUNTIF(A:A,C2) といった式を入れておきます。
Sheet1のB列で串刺し計算をします。 Sheet1のB2セルをアクティブにして 「=SUM(」 まで入力したら、 Sheet2のシートタブをクリック → Shiftキーを押しながらSheet4のシートタブをクリック →D2セルをクリック→Enter すると、=SUM(Sheet2:Sheet4!D2) といった式が入るので 必要行フィルドラッグします。
Sheet2〜Sheet4のA列の値を変更すると 該当のD列の計算結果が変わるので Sheet1のB列の結果も変わります。
(HANA)
他のシフトが同じブックにはないので シフト管理者がリストボックスから操作するということにしようと思います。 たくさん書いていただいたのにすみません；；
一つ質問があるのですが、 Sheet3でシフト表の横(BA、BB列)に、シフトに入っているかと訪問回数のプラスマイナスを加えました。 それをSheet4にコピーしたかったのですが、実行すると ヘルパー１〜３はコピーされるのですが、ヘルパー４以降は消えてしまってコピーできません。 コードを載せておきます。 HANAさんのコードからあまりいじってないはずなんですけど、何か余計なことをしてしまったのでしょうか？？
Sub shift() Dim tbl1 As Variant, tbl2 As Variant, x As Variant Dim dic As Object Dim Str As String, Msg As String Dim Col As Long, Fir As Long, Las As Long Dim i As Long, xr As Long
' 重複しないリストを作成する
Set dic = CreateObject("Scripting.Dictionary")
With Worksheets("ヘルパー")
'A3:AとA列の最終行から上方向の入力済み終端セルを選択する
tbl1 = .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("利用者")
'A2:EA列の最終行から上方向の入力済み終端セルを選択する
tbl2 = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("シフト")
'Rows.Countはワークシートの最大行、最大列を取得する
'ClearContentsは数式と文字をクリアにする
.Range("5:" & Rows.Count).ClearContents
'Interior.ColorIndexはセルを塗りつぶす xlNone線なし
.Range("5:" & Rows.Count).Interior.ColorIndex = xlNone
Sheets("ヘルパー").Range("B3:E23").Copy Sheets("シフト").Range("BC2:BF22")
'ReDimステートメントで初期化
'UBound関数は、配列の大きさを調べる
ReDim x(1 To UBound(tbl1, 1), 1 To 52)
For i = 1 To UBound(tbl1, 1)
dic(tbl1(i, 1)) = i
x(i, 1) = tbl1(i, 1)
Next
For i = 1 To UBound(tbl2, 1)
If dic.Exists(tbl2(i, 2)) Then
xr = dic(tbl2(i, 2))
Fir = tbl2(i, 4) * 24 * 60 / 15 - 25
Las = tbl2(i, 5) * 24 * 60 / 15 - 25
If Fir < 3 Or 51 < Las Then
Str = tbl2(i, 1) & "," & tbl2(i, 3) & _
Format(tbl2(i, 4), ",h:mm") & Format(tbl2(i, 5), "〜h:mm")
If x(xr, 52) = "" Then
x(xr, 52) = Str
Else
x(xr, 52) = x(xr, 52) & "・" & Str
End If
End If
Fir = Application.Max(2, Fir)
Las = Application.Min(52, Las)
x(xr, Fir) = tbl2(i, 1) & _
IIf(Fir = 2, Format(tbl2(i, 4), ",h:mm"), "") & Format(tbl2(i, 5), "〜h:mm")
Select Case tbl2(i, 3)
Case "身体介護"
'コーラル
Col = 22
Case "生活援助"
'コーラル
Col = 22
Case "予防訪問"
'コーラル
Col = 22
Case Else
'シニアライフ
'コーラル
Col = 22
End Select
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
Else
Str = i & "件目・" & tbl2(i, 2)
If Msg = "" Then
Msg = Str
Else
Msg = Msg & vbLf & Str
End If
End If
Next
.Range("A2").Resize(UBound(x, 1), UBound(x, 2)).Value = x
If Msg <> "" Then
MsgBox "未登録者名" & vbLf & Msg
End If
End With
With Worksheets("Sheet4")
Sheets("ヘルパー").Range("B3:E23").Copy Sheets("Sheet4").Range("Q2:T22")
Sheets("シフト").Range("BA2:BB22").Copy Sheets("Sheet4").Range("O2:P22")
End With
Set dic = Nothing
End Sub
＞一つ質問があるのですが、〜〜 の所は、どういった事かちょっとよくわかりません。
＞Sheet3でシフト表の横(BA、BB列)に、 ＞シフトに入っているかと訪問回数のプラスマイナスを加えました。 これは、いつ どこで 加えていますか？
＞'ClearContentsは数式と文字をクリアにする
＞ .Range("5:" & Rows.Count).ClearContents
注釈がつけてありますが、この部分で 5行目以下は一旦クリアされています。
ですから
＞Sheets("シフト").Range("BA2:BB22").Copy
BA2:BB22の範囲をコピーすることになっていますが、BA5:BB22の範囲は
何も入力が無い状態になっていると思います。
「5行目以下」なんてテキトーな範囲設定ではなく
.Range("A2:AZ" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
と言った感じで、範囲をきっちりにしてみてください。
(HANA)
大した事ではないのですが、書こうと思っていたことを書き忘れていたので追記です。
＞'Interior.ColorIndexはセルを塗りつぶす xlNone線なし
＞ .Range("5:" & Rows.Count).Interior.ColorIndex = xlNone
「xlNone」を何と表現するのが正確なのか分からないですが
意味合いとしては「指定しない（自動・無し）」と言った感じです。
今回は、.Interior.ColorIndex = xlNone なので セルを塗りつぶす色を指定しない に成ります。あえて書くなら xlNone色なし。
例えば、.LineStyle = xlNone だと、罫線のスタイル（太線とか、二重線とか）を 指定しないことになるので、＝線なし です。
当初は、数式も文字もセルの色も消えてしまえば良いと思ったので Clear（ClearContentsではなく）にしていたのですが、 これでは罫線も消えてしまうので ClearContents と Interior.ColorIndex = xlNone の二本立てにしました。
一時間毎の罫線の区切りは有った方が見やすいと思うので書いておいて貰って大丈夫です。
その下の
＞ Sheets("ヘルパー").Range("B3:E23").Copy Sheets("シフト").Range("BC2:BF22")
は、With Sheets("シフト") 〜 End With の間に入っているので
Sheets("シフト") は、書いておかなくて大丈夫です。
Sheets("ヘルパー").Range("B3:E23").Copy .Range("BC2:BF22")
それから、B3:E23 と BC2:BF22 と書いた場合範囲が合ってないと気持ち悪い割りに
範囲を合わせるのも面倒です。
貼付先は先頭セルだけを指定するので大丈夫です。
Sheets("ヘルパー").Range("B3:E23").Copy .Range("BC2")
最後の With Sheets("Sheet4") 〜 End With の所も同じです。
あ ＞'Rows.Countはワークシートの最大行、最大列を取得する って書いてありますね。。。単なる書き間違えとは思いますが Rows.Count なので、行の方だけです。 2003迄なら65,536、2007・2010なら 1,048,576 Columns.Count が、ワークシートの列の数です。 2003迄なら 256、2007・2010なら 16,384
(HANA)
指摘されたところ、直しました！ ありがとうございます＾＾
＞＞手作業なら、シフト表からシフトに入っているヘルパーを判断します。 ＞でしたら、↑の小さなサンプルでのセル番地で言うと B2:G7に「1」を入れるのと同時にH2:H7にも「1」を入れることにして H11に「1」を指定して抽出する と言う事でも良いのでしょうか？
まさにこのようにやりたいのですが、どうコードに書けばいいのでしょうか？ あとSheet4の時間軸？が1時間ごとになっていますが、これをシフト表と同じく15分ごとにすることは可能ですか？
＞シフトに入る事は出来るが、諸般の事情でSheet2に名前が無かった なんて事はあり得ないのでしょうか？ 今回はその日にシフトに入っているヘルパーの中から探したいので、そこは考えません。
（りら）
Sheet4のB:AY部分のコードは、りらさんに書いて貰おうと思っていますが。。。
＞まさにこのようにやりたいのですが、どうコードに書けばいいのでしょうか？ は、その過程で分かると思います。
＞Sheet3でシフト表の横(BA、BB列)に、シフトに入っているかと訪問回数のプラスマイナスを加えました。 これは、手順にも依ると思いますが Sheet1に作った方が良いと思います。 Sheet3のA列の名前は、Sheet1のA列の名前が変わると勝手に変わりますので。
(HANA)
時間がないので教えていただけませんか？ Sheet4のほうにコード加えてみました。 15分ごとの時間軸にしたので、開始時間にしか1が表示されません；；
Sub shift() Dim tbl1 As Variant, tbl2 As Variant, x As Variant Dim dic As Object Dim Str As String, Msg As String Dim Col As Long, Fir As Long, Las As Long Dim i As Long, xr As Long
' 重複しないリストを作成する
Set dic = CreateObject("Scripting.Dictionary")
With Worksheets("ヘルパー")
'A3:AとA列の最終行から上方向の入力済み終端セルを選択する
tbl1 = .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("利用者")
'A2:EA列の最終行から上方向の入力済み終端セルを選択する
tbl2 = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("シフト")
'Rows.Countはワークシートの最大行を取得する
'ClearContentsは数式と文字をクリアにする
.Range("A2:AZ" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
'Interior.ColorIndexはセルを塗りつぶす xlNone色なし
.Range("A2:AZ" & Rows.Count).Interior.ColorIndex = xlNone
Sheets("ヘルパー").Range("B3:E23").Copy .Range("BC2")
'ReDimステートメントで初期化
'UBound関数は、配列の大きさを調べる
ReDim x(1 To UBound(tbl1, 1), 1 To 52)
For i = 1 To UBound(tbl1, 1)
dic(tbl1(i, 1)) = i
x(i, 1) = tbl1(i, 1)
Next
For i = 1 To UBound(tbl2, 1)
If dic.Exists(tbl2(i, 2)) Then
xr = dic(tbl2(i, 2))
Fir = tbl2(i, 4) * 24 * 60 / 15 - 25
Las = tbl2(i, 5) * 24 * 60 / 15 - 25
If Fir < 3 Or 51 < Las Then
Str = tbl2(i, 1) & "," & tbl2(i, 3) & _
Format(tbl2(i, 4), ",h:mm") & Format(tbl2(i, 5), "〜h:mm")
If x(xr, 52) = "" Then
x(xr, 52) = Str
Else
x(xr, 52) = x(xr, 52) & "・" & Str
End If
End If
Fir = Application.Max(2, Fir)
Las = Application.Min(52, Las)
x(xr, Fir) = tbl2(i, 1) & _
IIf(Fir = 2, Format(tbl2(i, 4), ",h:mm"), "") & Format(tbl2(i, 5), "〜h:mm")
Select Case tbl2(i, 3)
Case "身体介護"
'コーラル
Col = 22
Case "生活援助"
'コーラル
Col = 22
Case "予防訪問"
'コーラル
Col = 22
Case Else
'シニアライフ
'コーラル
Col = 22
End Select
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
Else
Str = i & "件目・" & tbl2(i, 2)
If Msg = "" Then
Msg = Str
Else
Msg = Msg & vbLf & Str
End If
End If
Next
.Range("A2").Resize(UBound(x, 1), UBound(x, 2)).Value = x
If Msg <> "" Then
MsgBox "未登録者名" & vbLf & Msg
End If
End With
With Worksheets("Sheet4")
.Range("A2:AZ" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
.Range("A2:AZ" & Rows.Count).Interior.ColorIndex = xlNone
Sheets("ヘルパー").Range("B3:E23").Copy .Range("Q2")
Sheets("シフト").Range("BA2:BB22").Copy .Range("O2")
Sheets("Sheet4").Range("A1:BF1").Copy .Range("A24")
ReDim x(1 To UBound(tbl1, 1), 1 To 52)
For i = 1 To UBound(tbl1, 1)
dic(tbl1(i, 1)) = i
x(i, 1) = tbl1(i, 1)
Next
For i = 1 To UBound(tbl2, 1)
If dic.Exists(tbl2(i, 2)) Then
xr = dic(tbl2(i, 2))
Fir = tbl2(i, 4) * 24 * 60 / 15 - 25
Las = tbl2(i, 5) * 24 * 60 / 15 - 25
End If
Fir = Application.Max(2, Fir)
Las = Application.Min(52, Las)
x(xr, Fir) = 1
Select Case tbl2(i, 3)
Case "介護"
'コーラル
Col = 22
End Select
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
Next
.Range("A2").Resize(UBound(x, 1), UBound(x, 2)).Value = x
If Msg <> "" Then
MsgBox "未登録者名" & vbLf & Msg
End If
End With
Set dic = Nothing
End Sub
どうかお願いします！！
（りら）
取り敢えず、Sheet4はフラグが付けば良いだけなので。。。
以下、With Worksheets("Sheet4")〜End With の間に書いて居られる点
（Sheet4に関する事）のみ修正部分の提案です。
名前や回数、資格などをコピーするコードと一緒に
時間の部分には「0」をセットして下さい
.Range("B2:？22").Value = 0
Sheet3の時は変数xを使いましたが 直接セルに書き込んで行く方が簡単だと思うので 変数xを使わない方向で話を進めて行きます。 よって、変数x が関わって来る所は不要です。
ディクショナリへの登録は、既に済んでいるので 再度行う必要は有りません。 最後のメッセージも二回表示されても仕様が無いので、要らないと思います。
結局の所、Sheet3で色を塗っている範囲（と同じセル番地） .Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col に、色を塗るのではなく「1」を入れるので .Cells(xr + 1, Fir).Resize(, Las - Fir).Value = 1 と書く事に成ります。
色を塗りたい訳ではないので、色に関する部分も不要です。
＞まさにこのようにやりたいのですが、どうコードに書けばいいのでしょうか？ に関しては、「1」を入れたのと同じ行の ？列にも「1」を入れるので .Cells(xr + 1, ？).Value = 1 を加えて下さい。
「？」と書いた所は、該当の列番号を入れて下さい。 実際の表を見ているりらさんの方で 確実に分かると思いますので。
りらさんなら、この程度書いておけば分かると思っています。 やってみて下さい。
不要な部分を含んだコードに成るとは思いますが それは今後の課題にして頂ければと思います。
ちなみに
＞.Range("A2:AZ" & Rows.Count).Interior.ColorIndex = xlNone
と書くのなら、その上も
.Range("A2:AZ" & Rows.Count).ClearContents
で良い様な気もしますが。。。
(HANA)
本当にありがとうございます！ 自分なりにやってみました
With Worksheets("Sheet4")
.Range("A2:AZ" & Rows.Count).ClearContents
.Range("A2:AZ" & Rows.Count).Interior.ColorIndex = xlNone
Sheets("ヘルパー").Range("B3:E23").Copy .Range("BC2")
Sheets("シフト").Range("A2:A22").Copy .Range("A2")
Sheets("Sheet4").Range("A1:BF1").Copy .Range("A24")
.Range("B2:AZ22").Value = 0
For i = 1 To UBound(tbl2, 1)
If dic.Exists(tbl2(i, 2)) Then
xr = dic(tbl2(i, 2))
Fir = tbl2(i, 4) * 24 * 60 / 15 - 25
Las = tbl2(i, 5) * 24 * 60 / 15 - 25
End If
Fir = Application.Max(2, Fir)
Las = Application.Min(52, Las)
Select Case tbl2(i, 3)
Case "介護"
'コーラル
Col = 22
End Select
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
.Cells(xr + 1, Fir).Resize(, Las - Fir).Value = 1
' .Cells(xr + 1, "BA2").Value = 1
Next
End With
どこが1なのかわかりやすいので、色は付けることにしました。 .Cells(xr + 1, "BA2").Value = 1 のところですが、実行するとアプリケーション定義またはオブジェクト定義のエラーが出てしまいました；；
そこ以外はできました！ ありがとうございます＾＾
あとは抽出ですね・・ そこもできれば教えていただけませんか？ 以前に書いていただいたイメージのところの10行目まではできてます！
（りら）
.Cells(xr + 1, "BA").Value = 1 にしたら、できました！
お騒がせしました＾＾；
抽出の部分どうかお願いします！
（りら）
抽出に関しては、後々Sheet3から指定出来る様にするのが良いと思いますが 時間も無いと言う事なので、Sheet2から指定する様にしてみて下さい。
Sheet2の該当のデータ（これなく成った人のデータ）の行（列は何処でも良いと思いますが） をアクティブにして実行する事にします。
アクティブセルの有る行を一旦tbl2と言う変数に取り込んでおくと その後の処理も shift のコードと似せて作れるので良いかもしれません。
tbl2 = シート2のアクティブセルの有る行全体の.Range("A1:E1").Value
の様に、一旦取り込んでおいて
シート4のRange("A25").Value = "<>" & tbl2(1, 2)
とか
Select Case tbl2(1, 3)
Case "介護"
シート4のRange("・・・").Value = "○"
Case
とか・・・・ 時間の所は、Fir,Las の所を使い回して貰うと 条件条件にする部分も書けると思います。 今回は、前回と違って「0」を入れて下さいね。
条件部分や抽出結果などは、前の物が残っているといけませんので 最初に25行目以降は削除しておくのが良いかもしれないです。
(HANA)
すみません、理解できませんでした；； Sheet2はシフトに入る利用者さんのシフト時間のデータになっているので これなくなった人のデータはありません。
sheet4で、イメージでいうと11行目で探したい時間を指定して、15行目からその結果が出るということはできませんか？
（りら）
「シフトに入っている人がこれなくなった時にその代わりの人を捜すコードをつくる」 のかと思ってましたが。。。？
＞11行目で探したい時間を指定して、15行目からその結果が出るということはできませんか？ 検索条件を使用者が設定するので、抽出＆並べ替えを自動で と考えて居られるなら 抽出の部分は、まずはマクロの記録をとって下さい。
(HANA)
説明が足りなかったみたいで、すみません。
自分なりに調べてやってみたのですが、 シフトに入っているか、スキルはあるかのところの抽出はできたのですが 検索したい時間のところに０を書いても消えてしまって 時間の部分の抽出はできませんでした；；
それと、抽出結果のところで 抽出されたヘルパーの勤務（1とか0）が各時間初めの15分しか出てこなかったのですが・・？ たとえば、7:00〜7:15のところは出てくるが、7:15〜8:00は出てこない・・といったかんじです。
With Worksheets("Sheet4")
.Range("A2:AZ" & Rows.Count).ClearContents
.Range("A2:AZ" & Rows.Count).Interior.ColorIndex = xlNone
Sheets("ヘルパー").Range("B3:E23").Copy .Range("BC2")
Sheets("シフト").Range("A2:A22").Copy .Range("A2")
Sheets("Sheet4").Range("A1:BF1").Copy .Range("A24")
Sheets("Sheet4").Range("A1:BF1").Copy .Range("A27")
.Range("B2:BA22").Value = 0
For i = 1 To UBound(tbl2, 1)
If dic.Exists(tbl2(i, 2)) Then
xr = dic(tbl2(i, 2))
Fir = tbl2(i, 4) * 24 * 60 / 15 - 25
Las = tbl2(i, 5) * 24 * 60 / 15 - 25
End If
Fir = Application.Max(2, Fir)
Las = Application.Min(52, Las)
Select Case tbl2(i, 3)
Case "介護"
'コーラル
Col = 22
End Select
.Cells(xr + 1, Fir).Resize(, Las - Fir).Interior.ColorIndex = Col
.Cells(xr + 1, Fir).Resize(, Las - Fir).Value = 1
.Cells(xr + 1, "BA").Value = 2
Next
Range("A1:BF22").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("B24:AZ25", "BA24:BF25"), _
CopyToRange:=Worksheets("Sheet4").Range("A28"), _
Unique:=True
End With
このようなコードになったのですが、どこがダメなのでしょうか？
（りら）
これまで作って来たコードと 28行目以降に抽出するコードは 一緒には出来ないと思いますが。。。？
何か根本的な所で、話がかみ合って無い様に思います。
(HANA)
一緒にできないんですか？！ 一緒に書いてしまいました・・ だから時間の抽出が出来ないのですね
Sheet4に、HANAさんのイメージ図のようにつくりたいんです 変更の出た利用者さんの希望する時間と シフトに入っているヘルパー、 身体介護、生活援助などのスキル この3点をシート上に記入して、実行したらその抽出結果が出る・・という風に。
どうでしょうか？
（りら）
一緒に出来ないと言うか。。。そもそも一緒にする物じゃないと思ってましたが りらさんの反応からすると、そうではない様ですね。
私はこれまで 「予定していたヘルパーがこれなく成った時、代わりのヘルパーを捜す」 のに使用するのかと思っていましたが 「利用者の希望する時間が追加（変更）に成った時、入れるヘルパーを捜す」 のに使用するのですね？
もしかしたらその点が、話がスムーズに行かなかった点でしょうか？
＞このようなコードになったのですが、どこがダメなのでしょうか？
に関しては
＞検索したい時間のところに０を書いても消えてしまって
が原因で、その理由は
＞.Range("A2:AZ" & Rows.Count).ClearContents
だと思います。
データが入っている範囲（Sheet3からは、どうせ A2:A22 の範囲しかコピーして来ないので） この範囲を消す事にしたらどうですか？ A2:AZ22の範囲のデータを消すのと 抽出結果になる28行目以降を削除。
それから現時点で、どの列に何の項目が入っているか教えてもらえますか？
(HANA)
「利用者の希望する時間が変更されたときに、入れるヘルパーを探す」のほうになります。
＞.Range("A2:AZ" & Rows.Count).ClearContents
ここの部分を、
＞.Range("A2:AZ22" & Rows.Count).ClearContents
にしたのですが、アプリケーション定義またはオブジェクト定義のエラーが出てしまいました；；
Sheet4 A列にヘルパー名 B列からAZ列まで15分ごとの時間です BA列にシフトに入っているか BB列に訪問回数差 BC列からBF列までスキルの有無（身体、生活、予防、シニア）
ヘルパー人数21人なので これがBF22まで書かれています。
A24:BF25に希望条件を書き込むところを作っています。
どうかよろしくお願いします！！
（りら）
自分なりにやってみて、なんとか時間の部分の抽出もできました！ 本当にありがとうございました＾＾ HANAさんがいなかったら、できませんでした！ 感謝しています。
（りら）
無事出来ましたか。 なかなかレスが出来なくてスミマセン。
まだ作成途中でしたら 並べ替えの所は、小さなサンプルで試してみて 最後にセル番地だけ実際の範囲に変更する方向でやっていった方が 簡単かもしれません。
(HANA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.