貸出図書の管理をエクセルで

質問

貸出図書の管理をエクセル2010で行いたいと思います。
1行目はタイトルです。
2行目以降、
A列に記入日があります。
B列に書籍名があります。
C列に同じ行の書籍の貸出予定日（通常は記入日当日ですが先日付の場合もあります）があります。
D列にその書籍の回収予定日があります。
ここまでは貸し出しが決まったらA～D列まで一度に記入します。
E列にはその書籍の実際の回収日を回収された日に記入します。

このような場合で、同じ書籍の二重貸出登録を防ぐため、
(1) 同じ書籍が貸し出されており、その貸出予定日から回収予定日または実際の回収日以前の日付での貸出登録をした場合
(2) 同じ書籍に貸出予定があり、そ貸出予定日以後の日付を回収予定日とした貸出登録をした場合
このようなケースを判断できる関数またはVBAの方法をご教示いただければ幸いです。なお、書籍に重複はないものとします。

回答No.18

HohoPapa · ベストアンサー

>コードをNo16のと見比べましたが、2番目のDo Loop文の冒頭に
>If .Cells(LastLineNum, 5).Value = "" Then
>をいれて未返却のものだけを読み込むようにしたということでしょうか？

そうです。

ロジックとしては、
最下行から1行ずつ拾い、
上位行方向に総当たりしてます。

拾うときに、
返却済みも拾っていたことから直しました。
当初イメージしていたよりも
if文が増えたことで、バグの温床がふえました。
たっぷり、いろいろなパターンでテストしてください。

なお、
貸出予定日と回収予定日が逆転しているときのチェックを
行っていません。

動作テストと勉強を兼ね、
必要に応じて仕込んでみてください。

また、
subルーチンの行数が増え、追いにくくなったので、
Functionを使って、読みやすくしました。
（読みやすくしたつもりです）
もしよかったら、勉強に使ってみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim LastLineNum As Integer
　Dim LineCunter As Integer
　Dim Line1 As Integer
　Dim Line2 As Integer
　Dim wkjudge As Boolean
　Dim MsgText As String　　　　　　　　　　　　　'表示するメッセージ

　With ThisWorkbook.ActiveSheet
　　LineCunter = 2
　　Do
　　　If ((.Cells(LineCunter, 3).Value > .Cells(LineCunter, 4).Value) And _
　　　　　(.Cells(LineCunter, 3).Value <> "") And _
　　　　　(.Cells(LineCunter, 4).Value <> "")) Then
　　　　MsgText = Format(LineCunter, "0") & "行目の日付が逆転しています"
　　　　MsgBox MsgText
　　　　Exit Sub
　　　End If

　　　If ((.Cells(LineCunter, 1).Value = "") Or _
　　　　　(.Cells(LineCunter, 2).Value = "") Or _
　　　　　(.Cells(LineCunter, 3).Value = "") Or _
　　　　　(.Cells(LineCunter, 4).Value = "")) Then
　　　　Exit Do
　　　Else
　　　　LineCunter = LineCunter + 1　　　　　　　'カウントアップ
　　　End If
　　Loop
　　LastLineNum = LineCunter - 1　　　　　　　　 'これがデータの末尾行番号
　End With

　Line1 = 2
　Line2 = 3
　Do
　　Do
　　　wkjudge = isNotOverlap(Line1, Line2)
　　　Line2 = Line2 + 1
　　　If Line2 > LastLineNum Then
　　　　Exit Do
　　　End If
　　Loop
　　Line1 = Line1 + 1
　　If Line1 > LastLineNum - 1 Then
　　　Exit Sub
　　End If
　　Line2 = Line1 + 1
　Loop

End Sub

'//------------------------------------------------------------------------
'//　引数2つのレコードをチェック
'//　　　　　'書籍名が同じ、かつ、未返却、かつ、貸出期間が重複か？
'//------------------------------------------------------------------------
Function isNotOverlap(Line1 As Integer, Line2 As Integer) As Boolean
　Dim MsgText As String　　　　　　　　　　　　　'表示するメッセージ

　isNotOverlap = False

　With ThisWorkbook.ActiveSheet

　　If ((.Cells(Line1, 2).Value = .Cells(Line2, 2).Value) And _
　　　　(.Cells(Line1, 5).Value = "") And _
　　　　(.Cells(Line2, 5).Value = "") And _
　　　 (((.Cells(Line1, 3).Value >= .Cells(Line2, 3).Value) And _
　　　　(.Cells(Line1, 3).Value <= .Cells(Line2, 4).Value)) Or _
　　　 ((.Cells(Line1, 4).Value >= .Cells(Line2, 3).Value) And _
　　　　(.Cells(Line1, 4).Value <= .Cells(Line2, 4).Value)) Or _
　　　 ((.Cells(Line1, 3).Value <= .Cells(Line2, 3).Value) And _
　　　　(.Cells(Line1, 4).Value >= .Cells(Line2, 4).Value)))) Then
　　　MsgText = Format(Line1, "0") & "行目と" & _
　　　　　　　　Format(Line2, "0") & "行目" & vbCrLf & _
　　　　　　　　"書籍名:" & .Cells(Line1, 2).Value & vbCrLf & _
　　　　　　　　"の貸出期間が重複しています"
　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　isNotOverlap = True
　　End If
　End With
End Function

お礼

いろいろご指導いただき、ありがとうございました。
これで実用に耐えるものができそうです。
今後ともご指導をお願いいたします。

回答No.17

HohoPapa

ソースを見直したらバグを見つけました。

より下の行の返却日が削除されたとき
および、
並べ替えによって
より下の行の返却日が埋まり、かつ、
より上の行の返却日が空欄になったときに
ただしく判定していませんでした。

以下が、修正後のコードです。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim LastLineNum As Integer　　　　　　　　　　 'チェック元行番号
　Dim LineCunter As Integer　　　　　　　　　　　'カウンター
　Dim CheckDateF As Date　　　　　　　　　　　　 'チェック元貸出開始(予定)日
　Dim CheckDateT As Date　　　　　　　　　　　　 'チェック元返却予定日
　Dim CheckBookN As String　　　　　　　　　　　 'チェック対象書籍名
　Dim MsgText As String　　　　　　　　　　　　　'表示するメッセージ

　With ThisWorkbook.Sheets(1)

　　LineCunter = 2　　　　　　　　　　　　　　　 'データが2行目から開始しているから
　　Do　　　　　　　　　　　　　　　　　　　　　 'データの末尾行を求める
　　　If .Cells(LineCunter, 1).Value = "" Then　 '登録日が空欄になる前までSearch
　　　　Exit Do
　　　Else
　　　　LineCunter = LineCunter + 1　　　　　　　'カウントアップ
　　　End If
　　Loop
　　LastLineNum = LineCunter - 1　　　　　　　　 'これがデータの末尾行番号
　　If LastLineNum < 3 Then　　　　　　　　　　　'データが1件以下なら終了
　　　Exit Sub
　　End If

　　Do
　　　If .Cells(LastLineNum, 5).Value = "" Then　 '返却日が登録日が空欄なら読み飛ばす

　　　　CheckBookN = .Cells(LastLineNum, 2).Value　'チェック元書籍名を取得
　　　　CheckDateF = .Cells(LastLineNum, 3).Value　'チェック元貸出開始(予定)日を取得
　　　　CheckDateT = .Cells(LastLineNum, 4).Value　'チェック元返却予定日を取得

　　　　If ((CheckBookN = "") Or _
　　　　　　 (CheckDateF = 0) Or _
　　　　　　 (CheckDateT = 0)) Then
　　　　　Exit Sub
　　　　End If

　　　　For LineCunter = LastLineNum - 1 To 2 Step -1　'末尾の前行から２行目までをチェック

　　　　　If ((.Cells(LineCunter, 3).Value = "") Or _
　　　　　　 (.Cells(LineCunter, 4).Value = "")) Then
　　　　　　MsgText = Format(LineCunter, "0") & "行目" & _
　　　　　　　　　　　"日付が埋まっていません"
　　　　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　　　　Exit Sub
　　　　　End If

　　　　　'書籍名が同じ、かつ、未返却、かつ、貸出期間が重複なら
　　　　　If ((CheckBookN = .Cells(LineCunter, 2).Value) And _
　　　　　　 (.Cells(LineCunter, 5).Value = "")) Then
　　　　　　If (((CheckDateF >= .Cells(LineCunter, 3).Value) And _
　　　　　　　　 (CheckDateF <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　　((CheckDateT >= .Cells(LineCunter, 3).Value) And _
　　　　　　　　 (CheckDateT <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　　((CheckDateF <= .Cells(LineCunter, 3).Value) And _
　　　　　　　　 (CheckDateT >= .Cells(LineCunter, 4).Value))) Then
　　　　　　　MsgText = Format(LineCunter, "0") & "行目と" & _
　　　　　　　　　　　Format(LastLineNum, "0") & "行目" & vbCrLf & _
　　　　　　　　　　　"書籍名:" & CheckBookN & vbCrLf & _
　　　　　　　　　　　"の貸出期間が重複しています"
　　　　　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　　　　End If
　　　　　End If
　　　　Next LineCunter

　　　End If

　　　LastLineNum = LastLineNum - 1　　　　　　　'対象行を1行上へ
　　　If LastLineNum < 3 Then　　　　　　　　　　'対象行がデータ先頭行になったら
　　　　Exit Sub　　　　　　　　　　　　　　　　 '終了する
　　　End If

　　Loop

　End With

End Sub

お礼

ありがとうございます。
コードをNo16のと見比べましたが、2番目のDo Loop文の冒頭に
If .Cells(LastLineNum, 5).Value = "" Then
をいれて未返却のものだけを読み込むようにしたということでしょうか？

回答No.16

HohoPapa

ごめんなさい、コードをチェット間違えているので
再掲示します。
2017-12-14 20:13:03 回答No.11
↑のコメントで提示されたコードを見てみました。

運用でカバーすれば済むことかもしれませんし、
細かなことですが、一言。

If Target.Count > 1 Then Exit Sub

このコードがあるため、
例えば、既に日付の埋まった適当な行の3,4列目
（つまり、セル2つ）を一緒にコピーして、
新たな末尾の行に複写したときに
チェックが働きません。

For i = 2 To r - 1

このコードの場合、
データの2行目から、
まさに今入力した行の直前行までしかチェックしていません。

そのため、
添付のようなデータで、D4セルの日付を
2017/12/17に修正したときにチェックが漏れます。

私は、
操作者が複数行データを入力し、
その後まとめてチェックすることを想定していました。

Worksheet_Changeイベントで行うことを考えているようなので、
ちょっと書き換えて、以下に掲示します。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim LastLineNum As Integer　　　　　　　　　　 'チェック元行番号
　Dim LineCunter As Integer　　　　　　　　　　　'カウンター
　Dim CheckDateF As Date　　　　　　　　　　　　 'チェック元貸出開始(予定)日
　Dim CheckDateT As Date　　　　　　　　　　　　 'チェック元返却予定日
　Dim CheckBookN As String　　　　　　　　　　　 'チェック対象書籍名
　Dim MsgText As String　　　　　　　　　　　　　'表示するメッセージ

　With ThisWorkbook.Sheets(1)

　　LineCunter = 2　　　　　　　　　　　　　　　 'データが2行目から開始しているから
　　Do　　　　　　　　　　　　　　　　　　　　　 'データの末尾行を求める
　　　If .Cells(LineCunter, 1).Value = "" Then　 '登録日が空欄になる前までSearch
　　　　Exit Do
　　　Else
　　　　LineCunter = LineCunter + 1　　　　　　　'カウントアップ
　　　End If
　　Loop
　　LastLineNum = LineCunter - 1　　　　　　　　 'これがデータの末尾行番号
　　If LastLineNum < 3 Then　　　　　　　　　　　'データが1件以下なら終了
　　　Exit Sub
　　End If

　　Do
　　　CheckBookN = .Cells(LastLineNum, 2).Value　'チェック元書籍名を取得
　　　CheckDateF = .Cells(LastLineNum, 3).Value　'チェック元貸出開始(予定)日を取得
　　　CheckDateT = .Cells(LastLineNum, 4).Value　'チェック元返却予定日を取得

　　　If ((CheckBookN = "") Or _
　　　　　 (CheckDateF = 0) Or _
　　　　　 (CheckDateT = 0)) Then
　　　　Exit Sub
　　　End If

　　　For LineCunter = LastLineNum - 1 To 2 Step -1　'末尾の前行から２行目までをチェック

　　　　If ((.Cells(LineCunter, 3).Value = "") Or _
　　　　　　 (.Cells(LineCunter, 4).Value = "")) Then
　　　　　　MsgText = Format(LineCunter, "0") & "行目、" & _
　　　　　　　　　　　"日付が埋まっていません"
　　　　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　　　Exit Sub
　　　　End If

　　　　 '書籍名が同じ、かつ、未返却、かつ、貸出期間が重複なら
　　　　If ((CheckBookN = .Cells(LineCunter, 2).Value) And _
　　　　　 (.Cells(LineCunter, 5).Value = "")) Then
　　　　　If (((CheckDateF >= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateF <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　((CheckDateT >= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateT <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　((CheckDateF <= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateT >= .Cells(LineCunter, 4).Value))) Then
　　　　　　MsgText = Format(LineCunter, "0") & "行目と" & _
　　　　　　　　　　　Format(LastLineNum, "0") & "行目" & vbCrLf & _
　　　　　　　　　　　"書籍名:" & CheckBookN & vbCrLf & _
　　　　　　　　　　　"の貸出期間が重複しています"
　　　　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　　　End If
　　　　End If
　　　Next LineCunter

　　　LastLineNum = LastLineNum - 1　　　　　　　'対象行を1行上へ

　　　 If LastLineNum < 3 Then　　　　　　　　　　'対象行がデータ先頭行になったら
　　　　Exit Do　　　　　　　　　　　　　　　　　'終了する
　　　End If
　　Loop

　End With

End Sub

お礼

なるほど！これならデータのコピペも大丈夫ですね。
こちらを使わせていただきたいと思います。
ありがとうございました。

回答No.15

HohoPapa

2017-12-14 20:13:03 回答No.11
↑のコメントで提示されたコードを見てみました。

運用でカバーすれば済むことかもしれませんし、
細かなことですが、一言。

If Target.Count > 1 Then Exit Sub

このコードがあるため、
例えば、既に日付の埋まった適当な行の3,4列目
（つまり、セル2つ）を一緒にコピーして、
新たな末尾の行に複写したときに
チェックが働きません。

For i = 2 To r - 1

このコードの場合、
データの2行目から、
まさに今入力した行の直前行までしかチェックしていません。

そのため、
添付のようなデータで、D4セルの日付を
2017/12/17に修正したときにチェックが漏れます。

私は、
操作者が複数行データを入力し、
その後まとめてチェックすることを想定していました。

Worksheet_Changeイベントで行うことを考えているようなので、
ちょっと書き換えて、以下に掲示します。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim LastLineNum As Integer　　　　　　　　　　 'チェック元行番号
　Dim LineCunter As Integer　　　　　　　　　　　'カウンター
　Dim CheckDateF As Date　　　　　　　　　　　　 'チェック元貸出開始(予定)日
　Dim CheckDateT As Date　　　　　　　　　　　　 'チェック元返却予定日
　Dim CheckBookN As String　　　　　　　　　　　 'チェック対象書籍名
　Dim MsgText As String　　　　　　　　　　　　　'表示するメッセージ

　With ThisWorkbook.Sheets(1)

　　LineCunter = 2　　　　　　　　　　　　　　　 'データが2行目から開始しているから
　　Do　　　　　　　　　　　　　　　　　　　　　 'データの末尾行を求める
　　　If .Cells(LineCunter, 1).Value = "" Then　 '登録日が空欄になる前までSearch
　　　　Exit Do
　　　Else
　　　　LineCunter = LineCunter + 1　　　　　　　'カウントアップ
　　　End If
　　Loop
　　LastLineNum = LineCunter - 1　　　　　　　　 'これがデータの末尾行番号
　　If LastLineNum < 3 Then　　　　　　　　　　　'データが1件以下なら終了
　　　Exit Sub
　　End If

　　Do
　　　CheckBookN = .Cells(LastLineNum, 2).Value　'チェック元書籍名を取得
　　　CheckDateF = .Cells(LastLineNum, 3).Value　'チェック元貸出開始(予定)日を取得
　　　CheckDateT = .Cells(LastLineNum, 4).Value　'チェック元返却予定日を取得

　　　If ((CheckBookN = "") Or _
　　　　　 (CheckDateF = 0) Or _
　　　　　 (CheckDateT = 0)) Then
　　　　Exit Sub
　　　End If

　　　For LineCunter = LastLineNum - 1 To 2 Step -1　'末尾の前行から２行目までをチェック

　　　　If ((.Cells(LineCunter, 3).Value = "") Or _
　　　　　　 (.Cells(LineCunter, 3).Value = "")) Then
　　　　　Exit Sub
　　　　End If

　　　　 '書籍名が同じ、かつ、未返却、かつ、貸出期間が重複なら
　　　　If ((CheckBookN = .Cells(LineCunter, 2).Value) And _
　　　　　 (.Cells(LineCunter, 5).Value = "")) Then
　　　　　If (((CheckDateF >= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateF <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　((CheckDateT >= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateT <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　((CheckDateF <= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateT >= .Cells(LineCunter, 4).Value))) Then
　　　　　　MsgText = Format(LineCunter, "0") & "行目と" & _
　　　　　　　　　　　Format(LastLineNum, "0") & "行目" & vbCrLf & _
　　　　　　　　　　　"書籍名:" & CheckBookN & vbCrLf & _
　　　　　　　　　　　"の貸出期間が重複しています"
　　　　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　　　End If
　　　　End If
　　　Next LineCunter

　　　LastLineNum = LastLineNum - 1　　　　　　　'対象行を1行上へ

　　　 If LastLineNum < 3 Then　　　　　　　　　 '対象行がデータ先頭行になったら
　　　　Exit Do　　　　　　　　　　　　　　　　　'終了する
　　　End If
　　Loop

　End With

End Sub

お礼

ありがとうございます。

回答No.14

tsubu-yuki

ご丁寧に補足をありがとうございます。
なるほど、状況はある程度わかりました。
その上であえて、やはりエクセルで実装となると
他の回答者さまのご回答にもある通り、
エクセルはデータベース処理に特化したソフトではありませんので
かなりマンパワーが要りますよ、とだけは改めて申し上げておきます。
加え、アクセスは使えないし使える人もいない旨のコメントを見かけましたが、
ご自身で使ってみようとは思えませんか？
おそらく、それがいわゆる「啓発」というものです。
ご質問の内容にしてもここまでのやり取りにしても、
正直なところ、足りていないように見えます。
提示されたコードに対し「こう変えてみたが出来なかった」風の
コメントを付けているあたりからそれを感じ取れます。
はて、やりたいことは何ですか？
・自身の業務改善のために試行錯誤しながらでも作り上げたい
・自身の業務改善のために作ってくれる誰かを見つけたい
どちらでしょう？

さて、本題。
私からの回答は「段階を踏んで開発していくと良いですよ」という立場です。
なのでここでは進め方のアドバイス、必要なものは何か？に留めます。
・・・と言っても長くなってしまいますが、ご了承ください。
面倒であればスルーしてください。

第一段階として
「書籍をピックアップし、在庫状況・予約の有無を確認する」
から始めます。
ここはそんなに難しくはないですね。
シート上で実装するならVLOOKUP関数などを用いるのが簡単です。
「書籍の一覧」が存在するようですから、（コピーでも作って、）
在庫状況（貸出中か否か）・返却予定日はいつか・予約は入っているか
などなど、必要項目を列として追加してやります。

レイアウトは仮に・・
　書籍番号・書籍名・在庫状況・最新貸出日・最新返却日・貸出予定・・
とでもしておき、ココでは仮にコレを「マスター」と呼ぶことにします。
現段階ではテストデータとして添付図の赤文字の部分も手で入力しておきます。
この時、呼び出すキーとして「書籍の番号」のようなものがあると
前の回答の通り「書籍名称の細かな相違」を避けることができます。
注意点としては「キーになる番号には重複がないように附番する」こと。
データテーブルを考えるに当たり、コレは最重要です。
ですので、この段階では「書籍１冊につき、データは１行」を心がけます。
その他項目に関しては「セルに上書き」で作っていきます。
面倒だとは思いますが、焦らずにいきましょう。

それを別シートででも（図では同じシートですが）
VLOOKUP関数で呼び出してあげれば良いですね。
図の「参照するための範囲」の赤文字部分に、
VLOOKUP関数を使った式を仕込んであります。
　　Ｂ１１セル：=VLOOKUP($B$10,$A$3:$G$7,2,FALSE)
昇順に並ばない可能性もありますので、完全一致（FALSE）指定します。

最終的にはコレを「ユーザーフォーム」で実装してやると、
よりフレキシブルに使えるようになると思います。
が、焦らず、順番に・・です。

続いて、履歴のテーブルを作ります。
ココにもやはり基本に則り、「重複しないキー項目」を作ってやります。
まぁいわゆる「連番」です。
ですので、レイアウト（列方向）は
　連番・記入日・書籍番号・書籍名・貸出予定日・回収予定日・回収日・・
といった具合でしょうか。
ただし、「書籍名」は必要無いのとは言い添えておきます。
ここに、履歴や予定を溜めていきます。
今後もこの表に「手で打ち込む」とお考え下さい。
最終的にはユーザーフォームが出来るとここも楽できるようにはなります。

で、注意。
予約取り消しなどは行削除、とのことでしたが、
「一度振った連番は余程のことが無い限りふり直さない方が良い」です。
ついでに「常に連番昇順でソートしておく」のもお忘れなく。
連番が例えば「１０番から１８番に飛ぶ」になっていても
そのままにしておく方がおそらく後が楽です。
くどいようですが、連番には重複が無いように気をつけましょう。

ここまで出来たら、元の「マスターテーブル」に手を加えます。
まず、履歴のテーブルから「最新の履歴」を引きずり出します。
前の回答にもある通り、SUMPRODUCT関数でやってみました。
　　Ｄ３セル：=IFERROR(INDEX(D$17:D$29,SUMPRODUCT(MAX(($C$17:$C$29=$A3)*($A$17:$A$29)*($E$17:$E$29>0)))),"")
長い関数式は不得意なのですが、やむなしです。
きっと、もっと効率が良い式があると思います。
SUMPRODUCT・MAX関数を組合せて、最新の連番を取得し、
　　※書籍番号ごとの最新＝最大の連番を取るためにMAXを使います。
　　　重複が無いように・・とは、コレにもつながってきます。
INDEX関数でセルの中身を引っ張ってくる・・そんなイメージですね。
この式をＤ：Ｆ列にフィルしておきます。
Ｇ列だけちょっと違う式。
　　Ｇ３セル：=IFERROR(INDEX($G$17:$G$29,SUMPRODUCT(MAX(($C$17:$C$29=$A3)*($A$17:$A$29)*($G$17:$G$29>TODAY())))),"")
本日以降で貸出予定が入っていれば、その日付を返します。
で、これも必要分フィル。
　　※当然ながら、範囲はご自身の環境に合わせてください。
結果「０」が返ってくると鬱陶しいので、
表示形式に「mm/dd;;」を指定しておきます。
在庫状況はオマケですが、
　　Ｃ３セル：=IF(OR(F3>0,SUM(D3:G3)=0),"在庫",IF(AND(E3<TODAY(),F3=0),"延滞中","貸出中"))
こんな感じの式を入れています。

とりあえず、文章併せて１時間くらいで考えたものなので粗もあるでしょうし、
数が多くなるとどうなるのかわかりませんので悪しからずです。
そこそこ面倒ですが、ひとまずこの辺りまで
試しに作ってみてはいかがでしょう？
「個人的に使いたい」程度のモノなら、
お望みの（１）（２）の判断くらいなら条件付き書式や入力規則で、
履歴の管理ならフィルタやソートなど、
ＶＢＡを使わずともエクセルそのものに備わった一般機能で
現状では足りるレベルなのではないか？と思います。
この後、
・指定した書籍に関する履歴を抽出
・抽出された履歴を降順でソート（最新を上に）して表示
・対する履歴の新規登録
・存ずる履歴を修正（連番をキーに）
・延滞しているものについて警告
などなど、「データベースとして」足したい機能は色々ありますが、
それらはまだもう少し先の話。
エクセルでは物足りないと思ってからで十分間に合います。

１から１０までエクセルで頑張ろうと思うと
この先はユーザーフォームも絡めてＶＢＡが登場します。
考えようによりますが、このすべてをＶＢＡでこなすことも可能です。
が、まずはエクセルの機能をある程度使いこなすところから始めて、
その後ゆっくりステップアップしてはいかがですか？

といったところで、コレ以上長くしてもしょうがなさそうなので、この辺で。

まぁとにかく、段階を追って開発していくことをオススメします。
充分理解できていないまま先に先に進んでもしょうがないですからね。
まずは「形を作ること」に集中して、
「仕組み」はそのあとに付け加えていくと作りやすいですよ、多分。

ちなみに、この程度であればおそらく（当然、本人次第ですが）
「評価版」の期限内に勉強しながら十分組み上げられますよ。
アクセスの便利さ、リレーショナルデータベースの考え方を
体験してみても面白いかもしれません。
https://www.microsoft.com/ja-jp/evalcenter/evaluate-office-365-proplus

お礼

ありがとうございます。
アクセスでやったほうがいいことは十分わかるのですが、とりあえずはエクセルVBAでやってみます。
いろいろアドバイス、とても勉強になります。ありがとうございました。

回答No.13

imogasi

質問に上げている例は質問者が（図書の貸し出し返却などに）換骨脱胎したものか。それとも本当に図書の貸し出しを目指したものか。
後者の場合は、業者にソフトを頼むべきだし、頼むもんだ。
エクセル関数など持ち出すようでは、本件担当するスキルの段階ではないと思う。ＶＢＡもそんなに経験ないのだろうと推察する。
物品の在庫管理などでも、図書の管理でも同じような場面が多いので、どちらも同じぐらいのスキルを要すると思う。
最低でも、アクセスＶＢＡのようなものに習熟しないうちは、個人用の用途に限って考えるべきと思う。教えてもらえば、すぐできると思うのは、甘いと思う。

お礼

ありがとうございます。
でもたかだか200冊程度の貸出管理を業者に頼むひとがいますか？
ここでご教示いただいたアドバイスで何とかなりそうです。

回答No.12

bunjii

>しかし、変えても変えなくとも図の4行目（12/7）で先日付、たとえば2018/1/4以降の予約をした場合、5行目以降では1/3以前の予約ができなくなってしまうようです
メッセージボックスの「OK」ボタンをクリックするかEnterキーの打鍵でメッセージボックスが消えますので、その後に予約日を入力できます。
予約日を入力後もコードの論理を見直さないとメッセージボックスが表示されますので、動作確認をしながら修正してください。
回答No.5同様単なるアイディアなので使い勝手に合わせてコードを修正してください。

お礼

ありがとうございます。
以下のようにしてみました。これで行けそうです。
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim c As Long, r As Long
　　Dim b As String

　　c = Target.Column
　　r = Target.Row
　　b = ""
　　If Target.Count > 1 Then Exit Sub
　　If Target = "" Then Exit Sub
　　If r > 1 And r <= 200 And c > 2 And c < 5 Then
　　　　If Cells(r, 2) <> "" Then
　　　　　　For i = 2 To r - 1
　　　　　　　　If Cells(i, 2) = Cells(r, 2) And Cells(i, 5) = "" Then 'その本が未回収であれば
　　　　　　　　　　If Cells(i, 3) <= Cells(r, 3) And Cells(r, 3) <= Cells(i, 4) Then b = b & "貸出日が他の貸出期間中" & vbCrLf
　　　　　　　　　　If Cells(i, 3) <= Cells(r, 4) And Cells(r, 4) <= Cells(i, 4) Then b = b & "回収日が他の貸出期間中" & vbCrLf
　　　　　　　　　　If Cells(i, 3) >= Cells(r, 3) And Cells(r, 4) >= Cells(i, 4) Then b = b & "貸出期間中に他の予約有" & vbCrLf
　　　　　　　　End If
　　　　　　　　If b <> "" Then
　　　　　　　　　　MsgBox Cells(r, 2) & "は" & i & "行目の登録と重複しています。" & vbCrLf & b
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next i
　　　　End If
　　End If
End Sub

回答No.11

HohoPapa

>>・想定しているシートの末尾に新たな行を埋め
>>・予めシート上に配置したボタンを押すと
>>・必要なチェックが走り、
>>・ＮＧなら、その旨のメッセージが表示される
といった動作をするコードを書いてみました。

以下、簡単な取説
　書籍名、貸出開始日、返却予定日が必ず埋まっていることが前提
　データは2行目から開始し、途中に空行が無いことが前提
　並べ替えが行われても、フィルターを設定してもOK
　行削除されてもOK
　データ量が増え、レスポンスが落ちてきたら、
　　返却完了日の埋まった行を適当数削除してデータ量を減らす

以下のコードを標準モジュールに配置し
シートに適当なボタンを貼り、
そのボタンでこのコードが実行するようにしてみてください。

Option Explicit

Sub CheckMain()
　Dim LastLineNum As Integer　　　　　　　　　　 'チェック元行番号
　Dim LineCunter As Integer　　　　　　　　　　　'カウンター
　Dim CheckDateF As Date　　　　　　　　　　　　 'チェック元貸出開始(予定)日
　Dim CheckDateT As Date　　　　　　　　　　　　 'チェック元返却予定日
　Dim CheckBookN As String　　　　　　　　　　　 'チェック対象書籍名
　Dim MsgText As String　　　　　　　　　　　　　'表示するメッセージ

　With ThisWorkbook.Sheets(1)

　　LineCunter = 2　　　　　　　　　　　　　　　 'データが2行目から開始しているから
　　Do　　　　　　　　　　　　　　　　　　　　　 'データの末尾行を求める
　　　If .Cells(LineCunter, 1).Value = "" Then　 '登録日が空欄になる前までSearch
　　　　Exit Do
　　　Else
　　　　LineCunter = LineCunter + 1　　　　　　　'カウントアップ
　　　End If
　　Loop
　　LastLineNum = LineCunter - 1　　　　　　　　 'これがデータの末尾行番号
　　If LastLineNum < 3 Then　　　　　　　　　　　'データが1件以下なら終了
　　　Exit Sub
　　End If

　　Do
　　　CheckBookN = .Cells(LastLineNum, 2).Value　'チェック元書籍名を取得
　　　CheckDateF = .Cells(LastLineNum, 3).Value　'チェック元貸出開始(予定)日を取得
　　　CheckDateT = .Cells(LastLineNum, 4).Value　'チェック元返却予定日を取得
　　　For LineCunter = LastLineNum - 1 To 2 Step -1　'末尾の前行から２行目までをチェック

　　　　'書籍名が同じ、かつ、未返却、かつ、貸出期間が重複なら
　　　　If ((CheckBookN = .Cells(LineCunter, 2).Value) And _
　　　　　 (.Cells(LineCunter, 5).Value = "")) Then
　　　　　If (((CheckDateF >= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateF <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　((CheckDateT >= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateT <= .Cells(LineCunter, 4).Value)) Or _
　　　　　　　((CheckDateF <= .Cells(LineCunter, 3).Value) And _
　　　　　　　 (CheckDateT >= .Cells(LineCunter, 4).Value))) Then
　　　　　　MsgText = Format(LineCunter, "0") & "行目と" & _
　　　　　　　　　　　Format(LastLineNum, "0") & "行目" & vbCrLf & _
　　　　　　　　　　　"書籍名:" & CheckBookN & vbCrLf & _
　　　　　　　　　　　"の貸出期間が重複しています"
　　　　　　MsgBox MsgText　　　　　　　　　　　 'メッセージを表示
　　　　　End If
　　　　End If
　　　Next LineCunter

　　　LastLineNum = LastLineNum - 1　　　　　　　'対象行を1行上へ

　　　If LastLineNum < 3 Then　　　　　　　　　　'対象行がデータ先頭行になったら
　　　　Exit Do　　　　　　　　　　　　　　　　　'終了する
　　　End If
　　Loop

　End With

End Sub

お礼

ありがとうございます。
チェンジイベントでやってみました。
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim c As Long, r As Long
　　Dim b As String

　　c = Target.Column
　　r = Target.Row
　　b = ""
　　If Target.Count > 1 Then Exit Sub
　　If Target = "" Then Exit Sub
　　If r > 1 And r <= 200 And c > 2 And c < 5 Then
　　　　If Cells(r, 2) <> "" Then
　　　　　　For i = 2 To r - 1
　　　　　　　　If Cells(i, 2) = Cells(r, 2) And Cells(i, 5) = "" Then 'その本が未回収であれば
　　　　　　　　　　If Cells(i, 3) <= Cells(r, 3) And Cells(r, 3) <= Cells(i, 4) Then b = b & "貸出日が他の貸出期間中" & vbCrLf
　　　　　　　　　　If Cells(i, 3) <= Cells(r, 4) And Cells(r, 4) <= Cells(i, 4) Then b = b & "回収日が他の貸出期間中" & vbCrLf
　　　　　　　　　　If Cells(i, 3) >= Cells(r, 3) And Cells(r, 4) >= Cells(i, 4) Then b = b & "貸出期間中に他の予約有" & vbCrLf
　　　　　　　　End If
　　　　　　　　If b <> "" Then
　　　　　　　　　　MsgBox Cells(r, 2) & "は" & i & "行目の登録と重複しています。" & vbCrLf & b
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next i
　　　　End If
　　End If
End Sub

回答No.10

bunjii

>やってみましたが、ご掲示いただいた図で、12/13にカエルの楽園を1/4から貸出予定としようとしてもNGとなってしまします。
H7セルのNGは入力日時点で未返却なのでマークするだけの役目です。
貸し出し予約の入力を阻害するものではありません。
あなたのやりたいことは未だ確定していないと思いますので確定するまで手伝わせるのは虫が良すぎます。
有料でシステムエンジニアに依頼すべき内容です。
此処での回答は「このようなアイデアがあるので応用してみてはいかがですか？」と言う程度に受け止めてください。
尚、次の数式は予約日入力の場合は入力日の方が記入日より後日になるので、それを考慮するようにしてみました。
=IF((SUM(N(MAX(A3,C3)<=SUMPRODUCT((B$2:B2=B3)*((E$2:E2>MAX(A3,C3))+(E$2:E2="")>0)*((D$2:D2>MAX(A3,C3))+(E$2:E2="")>0)*D$2:D2)),SUMPRODUCT(N((B$2:B2=B3)*((E$2:E2>MAX(A3,C3))+(E$2:E2="")>0)*((D$2:D2>MAX(A3,C3)))>0)))>0)*(B3<>""),"NG","")

>やはり、返却完了日の翌日以降でないと貸出予定の登録ができないのはよろしくないです。
前述のように単なるアイデアの提示なのであなたが希望するように数式を修正してお使いください。

お礼

ご指摘、いちいちごもっともです。
ありがとうございました。

回答No.9

bunjii

回答No.5の追加です。
VBAでの対応を提示します。
C列またはD列の対象範囲をアクティブにしたときB列の書籍が貸し出し中または貸し出し予約期間のとき「○○○○は貸し出し中」と言うメッセージボックスを表示させるVBAコードは下記のようになります。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim b, c, r
c = ActiveCell.Column
r = ActiveCell.Row
b = "OK"
If r > 1 And r < 21 And c > 2 And c < 5 Then
If Cells(r, 2) <> "" Then
For i = 2 To r - 1
If Cells(i, 2) = Cells(r, 2) Then
If Cells(i, 4) > Cells(r, 1) Or Cells(i, 5) = "" Then b = "NG"
End If
Next i
If b = "NG" Then MsgBox Cells(r, 2) & "は貸出中です。"
End If
End If
End Sub

お礼

ありがとうございます。
なんとか実用にたえるものができそうです。
今後ともご指導をお願いいたします。

補足

ありがとうございます。No.5での関数の結果と同様のことをSelectionChangeイベントで確認できることがわかりました。
No5の補足で書いたように回収されてなくとも回収予定日を過ぎている貸出予約ができるよう
If Cells(i, 4) > Cells(r, 1) Or Cells(i, 5) = "" Then b = "NG"　を
If Cells(i, 4) > Cells(r, 1) Then b = "NG"
と変えてみました。
しかし、変えても変えなくとも図の4行目（12/7）で先日付、たとえば2018/1/4以降の予約をした場合、5行目以降では1/3以前の予約ができなくなってしまうようです。

回答No.8

lovelykajiyan

回答No.７です。
大事なことを忘れました。
一項(列)目加えて、
回収を終わったか否か、仮予定を受け付けたりする項目を設けては如何ですか？
これをフィルターで一気に必要な列だけを表示させるのです。
また、行の非表示で、不要になった記録はどんどん整理しましょう。
（過去の貸し出し記録が必要な場合があるかもしれません。
削除はさけましょう。）
オット！トイレットの記録も不要な〔名前〕は削除しましょう。
準備に多少時間を多く費やしても、本を貸し出したり、問い合わせのあった時に瞬時に対応できるのが、パソコンの本領と承知します。
実務に合わせて、組合せを工夫・改良して楽しく、
愉快な事務処理にしてくださ～い。
現役って、素晴らしいコトですね。

お礼

いろいろ事務作業のアドバイスをいただき、ありがとうございます。
これからもご指導よろしくお願いします！