Excelで日付けを入れたらスケジュールが引けるようにしたいのですが

質問

Excelで、1枚目に日付けをいれてそれが自動的に2枚目のスケジュール
に反映されてグラフのように反映されてほしいと思っています。

今は、別々に日付を入力したら、2枚目のシートに移りスケジュール
を引き直しています。

色々調べてみたのですが、解決できませんでした。

お教え頂ければありがたいです。
よろしくお願いします。

回答No.1

zap35 · ベストアンサー

エクセルでマクロを用いないでセルの色を変えるには「条件付き書式」を使う方法が考えられます。でも条件付き書式は他のシートを条件の中で参照することができません（Office2007は分かりませんが…）

従って「1枚目に日付けをいれてそれが自動的に2枚目のスケジュールに反映」するのは条件付き書式では無理です。どうしてもマクロが必要になりますが、質問の内容だけでは情報不足でマクロは書けません。

マクロの知識が乏しいなら、日付入力シートとスケジュールシートを合体させて「条件付き書式」で実現するのが一番の早道だと思います。

お礼

早速のご回答ありがとうございます！

お察しのとおり、マクロの知識は乏しいのですが
これを機に勉強をしたいと考えています。

情報は出来るだけ挙げたつもりなのですが、不足
がありましたら、なんなりとおっしゃって下さい。

よろしくお願いいたします。

回答No.11

pc_knight

pc_knightです。たびたびどうも。回答文字数制限の都合でANo.8の回答ではＶＢＡにエラー回避処理を入れてませんでした。
今回、以下のエラー回避処理を追加します。
（１） １８行の「c = c + 1: Cells(1, c).Value = dy」を削除し代わりに
c = c + 1
If c > 256 Then
Exit For
Else
Cells(1, c).Value = dy
End If
を追加
（２．ａ）２９行「hend = Sheets("貸出台帳").Cells(r, 8)」の次の行に
「If kasid <> "" And hend <> "" Then 」を行追加
（２．ｂ）末尾から９行手前の「Next r」の上の行に「End If」を行追加
☆エラーの生ずるのは次の（１）（２）の何れの場合で起きます。
（１） 各行のデータのうち最早開始月と最遅終了月の間隔すなわちシート「貼り出し用」の月日欄が約８ヶ月（厳密には２５０日間）を越えるとき
（２） シート「貸出台帳」のA列のNo.欄にデータが存在しているにもかかわらずG列の開始欄やH列の終了欄にデータ入っていないとき
☆その時、「実行時エラー’1004’:
アプリケーション定義またはオブジェクト定義のエラーです。」が生じます。tiwariuさんが経験されている、「400」というエラー表示とは異なり、そちらの原因解決にはつながりませんが・・・。
☆参考意見
「貼り出し用」の月日欄は約８ヶ月（厳密には２５０間、Excelの許容列数＝256）で打ち切られますが、どうしても３６５日に拡張したい場合は、２日間に１つのセルを割り当てるように作り変える必要があれます。

お礼

pc_knight様

ありがとうございました！！！
ようやくできました！

原因は、私のシートに隠れた列があって、それを
削除したらマクロがきちんと実行されました。

こんな初心者に素晴らしいマクロを書いて下さり
ありがとうございました。
感謝、感謝でございます。

長い間、お世話になりました！！

回答No.10

pc_knight

うまく動かない原因を捕らえるのは、なかなか難しいです。
我が家のパソコンにて
1枚目シート名:貸出台帳
No　　資産No　　 品名　　　分類(1)　　　分類(2)　　　現状　　　開始　　　終了　　　貸出者　　　場所
S001 　 123 　　 サーバ 　　固資 　　工具備品　　　貸出中 　　4月1日　　5月5日　　山田　 　　ラック
S002　　345　　　サーバ 　　固資 　　工具備品 　　貸出中 　　4月1日　　5月7日　　佐藤 　 　ラック

2枚目シート名：貼り出し用
で動作確認できております。どこか条件の異なる所がないでしょうか。

（１）「マクロを貼り付けて実行してみたのですが、「400」というエラー表示になり」は全く見当がつきません。
そのエラーが発生した際、「実行時エラー’400’:
アプリケーション定義またはオブジェクト定義のエラーです。」というメッセージと３種類のコマンドボタン（「終了(E)」、「デバッグ(D)」、「ヘルプ(H)」）が表示されたでしょうか。もし表示されてましたら
・「ヘルプ(H)」をクリツクしたら表示されるヘルプ画面内に大きなフォントで表示される表題名と
・「デバッグ(D)」、をクリツクしたら表示される黄色で色塗りされたＶＢＡの行の内容を調べたら原因究明に近づけるかもしれません。

（２）「1枚目のシートからデータが消えてしまい」も分りかねますが、１３行目の「Cells.Clear」にてシート内をすべてクリアしているので、これと関係ありそうです。
但し、クリアされるシートは、１２行の「Sheets("貼り出し用").Select」にて２枚目のシート「貼り出し用」に指定されています。従って1枚目のシート「貸出台帳」からデータが消えるのは分かりかねます。現実のシート名とＶＢＡコードに記述のシート名との整合がとれていないような感じがします。
小生がテストに使用したシート内容と同じデータでもエラーが生ずるでしょうか。

回答No.9

pc_knight

Tiwariuさん、ＯＫＷａｖｅの閲覧者の皆さん。　前回答に不備があり申し訳ありませんでした。
（１） コメント行としていれたつもりの「‘★」と「‘☆」の行（４ヶ所）が思いもよらぬ不備のあることが分りました。
この行は削除をお願いします。因みに「★」の左側の文字「‘」はアポストロフィー「'」（Shiftキー＋7キー）であるべきですが、前回回答文の作成にて文章貼付時になぜか別の分字に文字化けしたようです。チェック不足をお許し下さい。

（２）前回回答「‘★～‘★間か‘☆～☆間を選択、一方を要削除で」の意味の補足
（a）‘★～‘★間にある「.FormulaArray = "*"」を残して、‘☆～‘☆にある「.HorizontalAlignment = xlCenter」から「.Value = Sheets("貸出台帳").Cells(r, 9)」までの４行を削除する。
または
（ｂ）、‘★～‘★間にある「.FormulaArray = "*"」を削除して、‘☆～‘☆にある「.HorizontalAlignment = xlCenter」から「.Value = Sheets("貸出台帳").Cells(r, 9)」までの４行を残す。
の二者択一の意味のつもりでした。
「‘★～‘★間か‘☆～☆間を選択」ではなく、「‘★～‘★間か‘☆～☆間のどちらかを残して」と書くべきでした。
因みに（a）を採用すると貸出期間に対応するセルが半角の「＊」で埋まり、（ｂ）を採用すると貸出期間に対応するセルの色塗りと、貸出者名表示がされます。

お礼

pc_knight様

いつもありがとうございます。
また、お礼が遅くなり申し訳ありませんでした。

マクロを貼り付けて実行してみたのですが、「400」という
エラー表示になり、1枚目のシートからデータが消えてしまい
ました。

何度もお手を煩わせてしまい申し訳ありません。
ご教授頂ければと思います。

よろしくお願い致します。

回答No.8

pc_knight

改めて回答。‘★～‘★間か‘☆～☆間を選択、一方を要削除で
Sub Test()
dd = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
km = Array("No", "資産No", "品名", "設置", "貸出日", "返却予定日")
Sheets("貸出台帳").Select
mind = Application.WorksheetFunction.Min(Range("g2:g65536"))
maxd = Application.WorksheetFunction.Max(Range("h2:h65536"))
mmin = Month(mind)
mmax = Month(maxd)
If mmax < mmin Then
mmax = mmax + 12
End If
Sheets("貼り出し用").Select
Cells.Clear
For c = 1 To 6: Cells(1, c).Value = km(c - 1): Next c
c = 6
For m = mmin To mmax
For dy = 1 To dd((m - 1) Mod 12)
c = c + 1: Cells(1, c).Value = dy
Next dy
Next m
For r = 2 To Sheets("貸出台帳").Range("A65536").End(xlUp).Row
ck = 0: ch = 0
For c = 1 To 3
Cells(r, c).Value = Sheets("貸出台帳").Cells(r, c)
Next c
Cells(r, 5).Value = Sheets("貸出台帳").Cells(r, 7)
Cells(r, 6).Value = Sheets("貸出台帳").Cells(r, 8)
kasid = Sheets("貸出台帳").Cells(r, 7)
hend = Sheets("貸出台帳").Cells(r, 8)
mkasi = Month(kasid)
dkasi = Day(kasid)
mhenk = Month(hend)
dhenk = Day(hend)
If mkasi < mmin Then
mkasi = mkasi + 12
End If
For km = mmin To mkasi
If km > mmin Then
ck = ck + dd((km - 1) Mod 12)
End If
Next km
ck = ck + dkasi + 6
If mhenk < mmin Then
mhenk = mhenk + 12
End If
For hm = mmin To mhenk
If hm > mmin Then
ch = ch + dd((hm - 1) Mod 12)
End If
Next hm
ch = ch + dhenk + 6
Range(Cells(r, ck), Cells(r, ch)).Select
With Selection
‘★
.FormulaArray = "*"
‘★
‘☆
.HorizontalAlignment = xlCenter
.MergeCells = True
.Interior.ColorIndex = 35
.Value = Sheets("貸出台帳").Cells(r, 9)
‘☆
End With
Next r
Columns("e:f").NumberFormatLocal = "m""月""d""日"";@"
Columns("a:f").Columns.AutoFit
Columns("g:iv").Select
With Selection
.ColumnWidth = 2.5
.HorizontalAlignment = xlCenter
End With
End Sub

お礼

度々ありがとうございます。

>‘★～‘★間か‘☆～☆間を選択、一方を要削除で

とは、どのようにすればよいのでしょうか？

★だけを削除すると「コンパイル　構文エラー」になり
’と★を削除すると「インデックスが有効範囲にありません」
とエラーになってしまいます。

お手を煩わせてしまい申し訳ありません。
ご教授頂ければ幸いです。

よろしくお願い致します。

回答No.7

pc_knight

データの消滅の被害は大丈夫だったでしょうか。
記載内容からの原因の判断が難しいので更に次の点についてもう一度お聞かせいただけませんでしょうか。
（１）1枚目のシートと2枚目のシートのシート名
（２）1枚目のシート内の表示様式（具体的なデータで）
（３）作成したい２枚目のシート内（スケジュール表）の表示様式
（４）月日をインプットするセルの表示形式は「日付」になっているでしょうか
ご回答は、ANo.4に記載された表示例のような形で・・・
（例）
1枚目のシートの名前：Sheet1
機材名　スペック　資産番号　借出者　借出日　返却日
　甲　　　　　　　　　　　　　　　　　秋田　　　5月１日　　 5月4日
　乙　　　　　　　　　　　　　　　　　福島　　　5月3日　　　5月8日
　甲　　　　　　　　　　　　　　　　　千葉　　　5月7日　　　5月10日　

1枚目のシートの名前：Sheet2
機材名　設置場所　1　2　3　4　5　6　7　8　9　10　11　12
　甲　　　　　　　　　　 *　*　*　*　　　　　*　*　*　*
　乙　　　　　　　　　　　　　　 *　*　*　*　*　*

お礼

ご返答頂きありがとうございます。また、ご心配頂き
ありがとうございます。
ファイルをコピーして使っていたので、データは大丈夫です。

ご質問への回答ですが、以下の通りになります。

1枚目シート名:貸出台帳
No　　資産No　　 品名　　　分類(1)　　　分類(2)　　　現状　　　開始　　　終了　　　貸出者　　　場所
S001 　 123 　　 サーバ 　　固資 　　工具備品　　　貸出中 　　4月1日　　5月5日　　山田　 　　ラック
S002　　345　　　サーバ 　　固資 　　工具備品 　　貸出中 　　4月1日　　5月7日　　佐藤 　 　ラック

2枚目シート名：貼り出し用
　　　　　　　　　　　　　　　　　　　　　　　4
No　　資産No　品名　設置　 貸出日　返却予定日　12345678910
S001 123 　　　　A 　　IN-001　4月3日　　5月5日 　　　***********
S002 456 　　　　B 　 IN-002 4月10日　 5月10日

このような体裁になります。
お忙しい中申し訳ありませんが、ご教授頂ければと思います。

よろしくお願い致します。

回答No.6

pc_knight

（１）エラーに関して
「インデックスが有効範囲にありません」エラーの原因は、シート名の差異にあると思われます。
１枚目のシート名は「Sheet1」、２枚目のシート名は「Sheet2」という前提で作りました。
tiwaryuさんのシート名にマッチするようコードの変更が必要です。
仮に、１枚目のシート名を「貸出台帳」、２枚目のシート名を「スケジュール」と名付けている場合は、Worksheets("Sheet1")をWorksheets("貸出台帳")に、Worksheets("Sheet2")をWorksheets("スケジュール")に変更します。
（２）表の補足説明
（ａ）スケジュールを表示するシートの１行目に月表示が出ます。
例えば１枚目のシートの各行データのうち貸出日の最も早い日が５月であり、返却日の最も遅い日が６月であったなら、Ｃ１セルから３１ヶ分のセルを結合し「５月」と表示され、更にその右のセルから３０ヶ分のセルを結合し「６月」と表示されるようにしてあります。
（ｂ）２行目には、左から順に「機材名」、「設置場所」、「１」～「３１」、「１」～「３０」等と書き込まれるようにしてあります。
１行目、２行目は、貸出日の最も早い日の月と返却日の最も遅い日の月に応じてそれに見合って自動的に設定されます。（そのことから「dd = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)」と一年分の各月日数を配列してあります。）
従って、１行目、２行目の表示は、５～６月のように複数月になることもあります。但し１シートは２５６列の制限があるので貸出期間が８ヶ月分を超えるとエラーが発生します。また閏年についての補正は未配慮です。・・・もしかしてtiwaryuさんはスケジュール表を月毎にシート分けしていますか？。その場合はコード修正が必要になりますので別途検討で。
（ｃ）３行目以降はセルの着色と借用者名の表示です。

お礼

丁寧な解説を頂きありがとうございます。

Sheet名の変更をしてマクロを動作してみたのですが
1枚目のシートからデータが消え、2枚目のシート上で
エラー　400と表示されてしまいます。

また、今回のシートはスケジュール表を月ごとにシート
分けはしていません。

お忙しい中申し訳ありませんが、ご教授頂ければと思います。
よろしくお願い致します。

回答No.5

pc_knight

表の様式がANo.4(misatoanna)さんのご回答のようであるとすれば、次のＶＢＡでお試し下さい。
2枚目の設置場所はどこからデータをもってくるのか不明なためその処理は入れてありません。
Sub Test()
dd = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
Worksheets("Sheet1").Activate
mind = Application.WorksheetFunction.Min(Range("e2:e65536"))
maxd = Application.WorksheetFunction.Max(Range("f2:f65536"))
mmin = Month(mind)
mmax = Month(maxd)
If mmax < mmin Then
mmax = mmax + 12
End If
Worksheets("Sheet2").Activate
Cells.Clear
cl = 2
For m = mmin To mmax
For dy = 1 To dd((m - 1) Mod 12)
cl = cl + 1: Cells(2, cl).Value = dy
Next dy
Range(Cells(1, cl - dy + 2), Cells(1, cl)).Select
With Selection
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
Cells(1, cl - dy + 2).Value = (m - 1) Mod 12 + 1 & " 月"
Next m
For r = 2 To Worksheets("Sheet1").Range("A65536").End(xlUp).Row
clk = 0: clh = 0
kasid = Worksheets("Sheet1").Cells(r, 5)
hend = Worksheets("Sheet1").Cells(r, 6)
mkasi = Month(kasid)
dkasi = Day(kasid)
mhenk = Month(hend)
dhenk = Day(hend)
If mkasi < mmin Then
mkasi = mkasi + 12
End If
For km = mmin To mkasi
If km > mmin Then
clk = clk + dd((km - 1) Mod 12)
End If
Next km
clk = clk + dkasi + 2
If mhenk < mmin Then
mhenk = mhenk + 12
End If
For hm = mmin To mhenk
If hm > mmin Then
clh = clh + dd((hm - 1) Mod 12)
End If
Next hm
clh = clh + dhenk + 2
Range(Cells(r + 1, clk), Cells(r + 1, clh)).Select
With Selection
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
Cells(2, 1).Value = "機材名"
Cells(2, 2).Value = "設置場所"
Cells(r + 1, 1).Value = Worksheets("Sheet1").Cells(r, 1)
Cells(r + 1, clk).Value = Worksheets("Sheet1").Cells(r, 4)
Cells(r + 1, clk).Interior.ColorIndex = 35
Next r
Columns("A:B").Columns.AutoFit
Columns("C:iv").ColumnWidth = 2.5
End Sub

お礼

pc_knight様

サンプルありがとうございます！

現在、作業中なのですが貼り付けて実行をした所
インデックスが有効範囲にありません、とエラーに
なります。

サンプルを見直してみて、私のシートでは4月から7月
間でしか無いため、

dd = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
を
dd = Array(30, 31, 30, 31)

としています。

その他、試行錯誤して試しておりますが、上記のエラーが出て
しまいます。

再度、pc_knight様のサンプルコードを見て挑戦してみたいと
思います。

回答No.4

misatoanna

様式のご説明から考えますと、おそらく下記のような体裁になるのだと
思います。

Sheet1
機材名　スペック　資産番号　借出者　借出日　返却日
　甲　　　　　　　　　　　　　　　　　秋田　　　　1　　　4
　乙　　　　　　　　　　　　　　　　　福島　　　　3　　　8
　甲　　　　　　　　　　　　　　　　　千葉　　　　7　　　10

Sheet2
機材名　設置場所　1　2　3　4　5　6　7　8　9　10　11　12
　甲　　　　　　　　　　 *　*　*　*　　　　　*　*　*　*
　乙　　　　　　　　　　　　　　 *　*　*　*　*　*

Sheet1で機器甲の貸出が複数出たものをSheet2(*部分は塗りつぶし)の
ようにするのでしたら、条件付書式や一般関数では複雑すぎて荷が重過
ぎると思います。
しかも、上の例にはありませんが、セル上に借出者の名前まで表示する
のでしたら、ＶＢＡで処理されるべきと思います。

どなたかがサンプルをご提出くださるのをお待ちしましょう。
何度も補足説明をお願いしながら、お力になれなくてゴメンなさい。

お礼

お礼のコメントが遅くなり、すいませんでした。

misatoanna様が書いて下さった体裁の通りになります。
私のつたない説明を解読して頂きありがとうございます。
サンプルを頂いているのですが、現在作業中です。。

なにぶん、理解が浅いもので試行錯誤を繰り返しております。

回答No.3

misatoanna

> １枚目のシートで、貸出日付、貸出機材のスペック、資産番号を記入
> ２枚目のスケジュール表は、先頭の横一列が日付けで、機材の名称と
> 誰がいつまで借りるのかをセルに色を付けて表示。

書かれていませんが、１枚目では、当然借出者の名前も入力、ですね。
返却予定日は入力しないのですか？
２枚目は１行目が日付ということですが、１列目は何なのでしょうか。
　・借出者の名前？→　機材名はどう表示するのでしょうか。
　・機材の名称？　→　借出者名はどう表示するのでしょうか。

機材名または借出者は色で判別するというのでしたら、当然条件付書式
では対応できませんので、マクロ処理になってしまいますね。

お礼

度々ありがとうございます。

ご指摘のとおり、借出者の名前、返却予定日も入力します。。
２枚目について、説明が不十分でした、すいません。

２枚目は一番左に機材の品目、次に設置場所を明記してます。
貸し出し者の名前はスケジュールを引いたセルの上に書いています。

色で判別はしておらず、全て同じ色でスケジュールを引いています。

お手数をおかけしています。。
よろしくお願いします。

回答No.2

misatoanna

> 1枚目に日付けをいれて
> それが自動的に2枚目のスケジュールにグラフのように反映

各シートがそれぞれどういう様式なのか想像できませんので、具体的に
提示されたほうがよいと思います。

あと……、zap35さまの
> 条件付き書式は他のシートを条件の中で参照することができません
ですが、
私は2000ですが、セルに名前をつけその名前を指定すると、他シートで
も参照できました。　^_^;

お礼

早速のご回答ありがとうございます！

今は、貸出物の管理をしているのですが
１枚目のシートで貸出する日付をいれて２枚目のシートで
スケジュール表を作って貼り出しています。

１枚目のシートには、貸出する機材のスペックや、資産番号を
記入しており、２枚目のスケジュール表は、機材の名称と誰が
いつまで借りるのかをセルに色を付けて表示させています。
２枚目のスケジュール表は、先頭の横一列が日付けになって
います。

このような説明でよろしいでしょうか？

つたない説明で申し訳ありませんが、お教え頂ければと思います。