excelで会議室予約表の作成（マクロ）

Question

カテ間違いしてしまいましたので再度投稿します。
よろしくお願いいたします。

上司からの依頼で困っています。

添付のような、マクロボタンを設定し、

・登録ボタンを押したら該当時間の下の表のセルが塗りつぶされる
・削除ボタンを押したら削除される
・表のセルをクリックしたら、名前、内容などが表示される

ように、することは可能でしょうか？

マクロは初心者ですが絶対に完成させろといわれてしまいました。。。

そもそも、このような作りこみは可能でしょうか？
ちなみに、この表は数人が共有して使う予定です。

以上、お願いいたします。

merlionXX · Accepted Answer

> 後は削除させるのに取り掛かります。

がんばってください。
でも、さきほどのではいくらでも重複予約ができてしまいますね。
きっと上司に言われると思いますよ。

sei_s95さんががんばってる間に、わたくしはさきほどのコードにダブルブッキング防止機能を付加してみました。
こんなのはどうでしょう？

Sub 登録()
　　Dim x As Long, y As Long, z As Long, i As Long
　　Dim ws As Worksheet
　　Dim Rng As Range, c As Range
　　Set ws = Sheets("TEST")
　　With Sheets("Sheet1")
　　　　x = .Range("A2:A50").Find(What:=ws.Range("D2").Value, LookIn:=xlFormulas, _
　　　　LookAt:=xlWhole).Row
　　　　y = .Rows(1).Find(What:=ws.Range("D3").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column
　　　　z = .Rows(1).Find(What:=ws.Range("D4").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column - 1
　　　　Set Rng = .Range(.Cells(x, y), .Cells(x, z))
　　　　For Each c In Rng
　　　　　　If c.Interior.ColorIndex <> xlNone Then
　　　　　　　　i = i + 1
　　　　　　End If
　　　　Next c
　　　　
　　　　Select Case True
　　　　　　Case i = Rng.Count
　　　　　　MsgBox "ダブルブッキング！！", vbCritical, "Σ（￣ロ￣lll) ": End
　　　　　　Case i > 0
　　　　　　MsgBox "指定時間の一部が予約されています。", vbCritical, "ヾ(￣□￣； )ノ！": End
　　　　　　Case Else
　　　　　　MsgBox "予約しました。", vbInformation, "(´^∇^)σ"
　　　　End Select
　　　　
　　　　With Rng
　　　　　　.Interior.ColorIndex = 6
　　　　　　.ClearComments
　　　　　　With .Cells(1)
　　　　　　　　.AddComment
　　　　　　　　.Comment.Visible = False
　　　　　　　　.Comment.Text Text:=ws.Range("A2").Value & "/" & ws.Range("D3").Text
　　　　　　End With
　　　　End With
　　End With
End Sub
　　　　LookAt:=xlWhole).Row
　　　　y = .Rows(1).Find(What:=Range("D3").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column
　　　　z = .Rows(1).Find(What:=Range("D4").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column - 1
　　　　.Range(.Cells(x, y), .Cells(x, z)).Interior.ColorIndex = 6
　　　　.Range(.Cells(x, y), .Cells(x, z)).ClearComments
　　　　With .Cells(x, y)
　　　　　　.AddComment
　　　　　　.Comment.Visible = False
　　　　　　.Comment.Text Text:=Range("A2").Value & "/" & Range("D3").Text
　　　　End With
　　End With
End Sub

merlionXX · Answer

merlionXXです。
もうお気づきとは思いますが、ANo6で貼り付けたコードの下に、なぜか余分な14行がはりついていました。
（わたしのコピペミスに決まってますが）
End Subの下の14行は削除してください。

merlionXX · Answer

ANo4　merlionXXです。

> 実際は入力を別シートにするので以下のようにしてみました。
> アドバイスいただけましたら幸いです。

ご自身でアレンジできないなら最初からありのままの姿で質問なさったほうが良いのでは？
二度手間になります。

お書きになったコードを見る限り、
会議室予約表はSheet1にある。
日付欄はA2：A50
時間欄は１行目

入力するのはSheet1でないが、シート名は不明。但し、マクロ実行時には必ずアクティブである。
そのアクティブなシートで
日付はD2
開始時間はD3
終了時間はD4
A2セルは、多分予約者名か会議名
普通、こんなことは回答者に解読させるのではなく質問者が明記することだと思いますよ。

入力するシート名がわからなかったので、とりあえず TEST というシート名としました。
下記コードの、Set ws = Sheets("TEST")　の　TEST　部分を実際のものに書き換えてください。

Sub 登録()
　　Dim x As Long, y As Long, z As Long
　　Dim ws As Worksheet
　　Set ws = Sheets("TEST")
　　With Sheets("Sheet1")
　　　　x = .Range("A2:A50").Find(What:=ws.Range("D2").Value, LookIn:=xlFormulas, _
　　　　LookAt:=xlWhole).Row
　　　　y = .Rows(1).Find(What:=ws.Range("D3").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column
　　　　z = .Rows(1).Find(What:=ws.Range("D4").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column - 1
　　　　.Range(.Cells(x, y), .Cells(x, z)).Interior.ColorIndex = 6
　　　　.Range(.Cells(x, y), .Cells(x, z)).ClearComments
　　　　With .Cells(x, y)
　　　　　　.AddComment
　　　　　　.Comment.Visible = False
　　　　　　.Comment.Text Text:=ws.Range("A2").Value & "/" & ws.Range("D3").Text
　　　　End With
　　End With
End Sub

merlionXX · Answer

わたしのはまたエクセル2000なので、あなたのでもできるかどうかは自信がありませんが・・・。
データの配置は添付画像を見てください。

Sub 登録()
　　Dim x As Long, y As Long, z As Long
　　x = Range("A11:A41").Find(What:=Range("A4").Value, LookIn:=xlFormulas, _
　　　　LookAt:=xlWhole).Row
　　y = Rows(10).Find(What:=Range("A5").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column
　　z = Rows(10).Find(What:=Range("A6").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column - 1
　　Range(Cells(x, y), Cells(x, z)).Interior.ColorIndex = 6
　　Range(Cells(x, y), Cells(x, z)).ClearComments
　　With Cells(x, y)
　　　　.AddComment
　　　　.Comment.Visible = False
　　　　.Comment.Text Text:=Range("A2").Value & "/" & Range("A3").Value
　　End With
End Sub

Sub 削除()
　　Dim x As Long, y As Long, z As Long
　　x = Range("A11:A41").Find(What:=Range("A4").Value, LookIn:=xlFormulas, _
　　　　LookAt:=xlWhole).Row
　　y = Rows(10).Find(What:=Range("A5").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column
　　z = Rows(10).Find(What:=Range("A6").Text, LookIn:=xlValues, _
　　　　LookAt:=xlWhole).Column - 1
　　Range(Cells(x, y), Cells(x, z)).Interior.ColorIndex = xlNone
　　Range(Cells(x, y), Cells(x, z)).ClearComments
End Sub

deltaforce_1 · Answer

尚、作成時ですが、マクロとして記録した後にそのコードを使って作成する方法があります
手元にExcel2007しか無い為に多少用語が違っているかもしれませんが

マクロ機能：Alt+F8
行った操作が記録でき、コードになって格納されます

VBAEditor：Alt+F11
実際に動作させるコードを記述するのはここです。

ちょっと画像が粗いので、タブが表示されているかどうかは判らないのですが
実際に開発する際には、設定で開発タブ等を表示させた方がいいかと思います。
ボタンやコンボボックス（ドロップダウンリスト）等、必要な物を画面上に配置する際にも使う筈です

Excel VBAに関しては色々サイトがありますので、やりたい事は割と見つかり易い方かと思います。
http://excelvba.pc-users.net/

deltaforce_1 · Answer

当方PG、今年で3年目です。

どういう会社なのかは今一つ分かりませんが…
PGとか居ない普通の会社であれば、こういうモノを結構甘く見てるような気がします
これを完成させても、今後も大変かもしれませんが…それは置いといて。

○仕様についての疑問
　作り込みは可能です。しかし、どのように作るべきかはもう少し悩むべきだと思います
　１．日付を入力する欄が見えませんが、何処で入力しますか？
　　　（ボタンを押した当日？入力欄が足りない？）
　２．削除ボタンを押したとき、何を基準に削除しますか？
　　　（開始時間、終了時間、または両方？）

○注意点
　あとで困るかと思いますので、いきなり酷い事を云いますが
　実用に耐えられないかと思います。
　●共有
　　１．共有する際には「同時に」と云う点を考えなければいけない事
　　２．他人の編集を即座に反映させられるような物を考えなければならない事
　　　　（他人に気付かずに上書きされたら意味がないですよね…）
　●バージョンの問題
　　１．画面はExcel２０１０ですが、全員２０１０を使用していますか？
　　　　バージョンが違う場合は一部の関数や動作が異なります(※対応する事は可能ですが…
　●例外
　　１．時間以外を入力した場合
　　２．開始時間と終了時間を逆にした場合
　　３．文字や記号、日付を入力した場合
　　４．セルをカットアンドペーストした場合
　　　etc...

これらが出来ないようにロックを掛けたり、入力を確認したりするステップがそこそこあります
　　その辺りは上司と色々確認しあって決めないといけないと思いますが…
　　…所で、期限はどれくらいありますでしょうか…？

aokii · Answer

可能です。
各操作をまずはマクロ登録して、各ボタンに適用させてみてください。

excelで会議室予約表の作成（マクロ）

> 後は削除させるのに取り掛かります。

この回答への補足

merlionXXです。

ANo4 merlionXXです。

この回答への補足

わたしのはまたエクセル2000なので、あなたのでもできるかどうかは自信がありませんが・・・。

この回答への補足

尚、作成時ですが、マクロとして記録した後にそのコードを使って作成する方法があります

当方PG、今年で3年目です。

この回答への補足

可能です。

この回答への補足

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

ANo4　merlionXXです。