エクセル 保管料の計算式を作りたい

質問

1月1日から1月15日
1月16日から1月31日
2月1日から2月15日
2月16日から2月28日　
・・・・・
という風に半月毎を1期として
保管料5円を支払います。

例）
-1月1日に入庫して、1月15日に出庫　1期分　5円
-1月1日に入庫して　1月16日に出庫　2期分　10円
-1月2日に入庫して、1月13日に出庫　1期分　5円
-1月13日に入庫して　2月5日に出庫　1月後半分と2月前半分の2期分で　10円
-2月3日に入庫して　4月3日に出庫　 2月前半、2月後半、3月前半、3月後半、4月前半の5期分で　5期ｘ5円=25円

といった規則になっています。
これをエクセルの計算式で自動計算できるようにしたいです。
入庫の日付と出庫の日付と金額を入れると自動で金額がでるようにしたいです。

詳しい方ご教示いただければ幸いです。

回答No.11

kkkkkm · ベストアンサー

No.9No.10の訂正です。

継ぎ足していったので冗長になりました。

年をまたぐのが複数年であってもそうでなくても、また、またがなくても以下の式でいけると思います。

=(((MONTH(B1)-MONTH(A1)+1)+((YEAR(B1)-YEAR(A1))*12))*10)-IF(DAY(A1)>15,5,0)-IF(DAY(B1)<=15,5,0)

お礼

本当に何度も改良して頂き、ありがとうございます。これで完璧にできました。
シンプルな式でとてもうれしいです。
本当に有難うございます。

ベストアンサーとさせていただきます。

回答No.14

SI299792

画像の様な表とします。

C2: =((DAY(A2)<16)+(DAY(B2)>15)+DATEDIF(EOMONTH(A2,0)+1,EOMONTH(B2,0)+1,"M")*2)*5
下へコピペ。

お礼

ありがとうございます。
知らない関数勉強になります。
とてもシンプルにできるのですね。

ありがとうございます。
今回は何度も解凍してくださった方をべストにさせて頂きましたが、とても感謝しています。有難うございます。

回答No.13

NuboChan

無駄を無くしてコードをスリムにしました。

Option Explicit

Sub test()

Dim 初日 As Date
Dim 最終日 As Date
Dim i As Long
Dim fad As Long, fid As Long
Dim ml As Long

初日 = Application.InputBox(prompt:="初日の日付を入力してください。", _
Title:="日付入力　(例 : 2020/1/1)", _
Type:=1)

If 初日 = "0:00:00" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

最終日 = Application.InputBox(prompt:="最終日の日付を入力してください。", _
Title:="日付入力　(例 : 2020/1/1)", _
Type:=1)

If 最終日 = "0:00:00" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

'処理する行数
ml = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To ml
If 初日 >= Cells(i, "A") And 初日 <= Cells(i, "B") Then
Cells(i, "C") = "○"
fad = Range("C1:c" & ml).Find("○").Row
End If
If 最終日 >= Cells(i, "A") And 最終日 <= Cells(i, "B") Then
Cells(i, "C") = "●"
fid = Range("C1:c" & ml).Find("●").Row
End If
Next

MsgBox "保管料 = " & (fid - fad) * 5 + 5 & " 円"

End Sub

Sub kubun()

Dim i As Long, ii As Long, k As Long
Dim 初年度 As Long, 作成年分 As Long
Dim sd As Date

'書き出しセル初期化
Range("A:A").ClearContents
Range("B:B").ClearContents
Range("C:C").ClearContents

'開始年指定
初年度 = Application.InputBox(prompt:="開始年を指定してください。", _
Title:="年の入力　(例 : 2020)", _
Type:=1)

If 初年度 = "0" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

sd = 初年度 & "/1/1"

'何年分作成するか
作成年分 = Application.InputBox(prompt:="作成する期間を指定してください。", _
Title:="年単位で入力　(例 : 4)", _
Type:=1)

If 作成年分 = "0" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

'列の書式設定
Columns(1).NumberFormatLocal = "yy/m/d"
Columns(2).NumberFormatLocal = "yy/m/d"

k = 1
For ii = 1 To 作成年分 * 24
Cells(k, "A") = sd
Cells(k, "A").Offset(0, 1) = DateAdd("d", 14, sd)
Cells(k, "A").Offset(1, 0) = DateAdd("d", 15, sd)
Cells(k, "A").Offset(1, 1) = Application.EoMonth(sd, 0)
sd = DateAdd("m", 1, sd) '月の更新
k = k + 2
Next

End Sub

お礼

ありがとうございます。
改良版も何度も送っていただき有難うございます。

VBAがあまり得意ではないのですが、とても勉強になります。
今回は関数式で教えて頂いた方をべストにさせて頂きましたが、とても感謝しています。

回答No.12

NuboChan

少しコードを修正しました。
（含む不具合箇所修正）

まだBUGfixが不十分だと思えます。

Option Explicit

Sub test()

Dim 初日 As Date
Dim 最終日 As Date
Dim i As Long
Dim fad As Long, fid As Long
Dim ml As Long

Range("C:C").ClearContents

初日 = Application.InputBox(prompt:="初日の日付を入力してください。", _
Title:="日付入力　(例 : 2020/1/1)", _
Type:=1)

If 初日 = "0:00:00" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

最終日 = Application.InputBox(prompt:="最終日の日付を入力してください。", _
Title:="日付入力　(例 : 2020/1/1)", _
Type:=1)

If 最終日 = "0:00:00" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

'処理する行数
ml = Cells(Rows.Count, 1).End(xlUp).Row - 1

For i = 1 To ml
If 初日 > Cells(i, "A") And 初日 <= Cells(i, "B") Then
Cells(i, "C") = "○"
fad = Range("C1:c" & ml).Find("○").Row
End If
If 最終日 > Cells(i, "A") And 最終日 <= Cells(i, "B") Then
Cells(i, "C") = "●"
fid = Range("C1:c" & ml).Find("●").Row
End If
Next

MsgBox "保管料 = " & (fid - fad) * 5 + 5 & " 円"

End Sub

Sub kubun()

Dim i As Long, ii As Long
Dim 初年度 As Long, 作成年分 As Long
Dim sd As Date

'開始年指定
初年度 = Application.InputBox(prompt:="開始年を指定してください。", _
Title:="年の入力　(例 : 2020)", _
Type:=1)

If 初年度 = "0" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

sd = 初年度 & "/1/1"

Cells(1, "A").Value = sd

'何年分作成するか
作成年分 = Application.InputBox(prompt:="作成する期間を指定してください。", _
Title:="年単位で入力　(例 : 4)", _
Type:=1)

If 作成年分 = "0" Then
MsgBox "キャンセルが押されたので処理を中止します。"
Exit Sub
End If

'４年分作成なら (192/48=4)
'1年分＝１２ (４つで１組,４年分＝１２ｘ４）
For ii = 1 To 作成年分 * 12
Cells(4 * ii - 2, "A") = DateAdd("d", 14, sd)
Cells(4 * ii - 1, "A") = DateAdd("d", 15, sd)
Cells(4 * ii, "A") = Application.EoMonth(sd, 0)
sd = DateAdd("m", 1, sd) '月の更新
Cells(4 * ii + 1, "A") = sd
Next

'４年分作成なら (192/48=4)
For i = 1 To 作成年分 * 48
Cells(i, "B") = Cells(i + 1, "A")
Next

'列の書式設定
Columns(1).NumberFormatLocal = "yy/m/d"
Columns(2).NumberFormatLocal = "yy/m/d"

End Sub

回答No.10

kkkkkm

No.9の追加です。

年を複数年またぐ場合には、12を年数分加算します。

=((IF(MONTH(B1)>=MONTH(A1),(MONTH(B1)-MONTH(A1)+1),(MONTH(B1)-MONTH(A1)+1)+((YEAR(B1)-YEAR(A1))*12)))*10)-IF(DAY(A1)>15,5,0)-IF(DAY(B1)<=15,5,0)

回答No.9

kkkkkm

> 年をまたいだ計算もしたいのですが、アイデアあればご教示いただきたく

なんか強引なやり方になりましたが
年をまたぐ場合は、出庫月から入庫月を引くと差がマイナスになるので、その時(出庫月が入庫月より小さい場合)は12を加算するという方法にしました。上記の出庫月、入庫月は年を含まない月の値の事を指します。

=((IF(MONTH(B1)>=MONTH(A1),(MONTH(B1)-MONTH(A1)+1),(MONTH(B1)-MONTH(A1)+1)+12))*10)-IF(DAY(A1)>15,5,0)-IF(DAY(B1)<=15,5,0)

回答No.8

NuboChan

関数じゃなく、初心者のマクロですが
とりあえずUPします。

多分間違えがある前提で試して見てください。

スキルがないので先に日付の一覧を作成して
日々を指定してヒットした列数から計算しています。

Option Explicit

Sub test()

Dim 初日 As Date
Dim 最終日 As Date
Dim i As Long
Dim fad As Long, fid As Long

Range("C:C").ClearContents

初日 = Application.InputBox(prompt:="初日の日付を入力してください。", _
Title:="日付入力", _
Type:=1)

If TypeName(初日) = "Boolean" Then
MsgBox "キャンセルします"
Exit Sub
End If

最終日 = Application.InputBox(prompt:="最終日の日付を入力してください。", _
Title:="日付入力", _
Type:=1)

If TypeName(最終日) = "Boolean" Then
MsgBox "キャンセルします"
Exit Sub
End If

For i = 1 To 192
If 初日 >= Cells(i, "A") And 初日 <= Cells(i, "B") Then
Cells(i, "C") = "○"
fad = Range("C1:c200").Find("○").Row

If 最終日 >= Cells(i, "A") And 最終日 <= Cells(i, "B") Then
Cells(i, "C") = "●"
fid = Range("C1:c200").Find("●").Row
End If
Next

MsgBox "保管料 = " & (fid - fad) * 5 + 5 & " 円"

End Sub

Sub kubun()

Dim i As Long, ii As Long
Dim sd As Date

sd = "2023/1/1"

Cells(1, "A").Value = sd

For ii = 1 To 48
Cells(4 * ii - 2, "A") = DateAdd("d", 14, sd)
Cells(4 * ii - 1, "A") = DateAdd("d", 15, sd)
Cells(4 * ii, "A") = Application.EoMonth(sd, 0)
sd = DateAdd("m", 1, sd)
Cells(4 * ii + 1, "A") = sd
Next

For i = 1 To 192
Cells(i, "B") = Cells(i + 1, "A")
Next

Columns(1).NumberFormatLocal = "yy/m/d"
Columns(2).NumberFormatLocal = "yy/m/d"

End Sub

回答No.7

imogasi

もうすこし、ルールを明確にして質問すること。これは質問者の仕事だ。
明確化とは、
　（１）文章と（２）箇条書き文章か、（３）表作製が目標だ。
具体的な日付を離れて書くべきだろう。
社内規定などに、決められた文章があるだろう。
例の数の例示が多いだけでは、説明には、十分ではない。
両方併用・併記が望ましい。（例　しかしＸＸの場合は、・・・）
コンピューターを使うときは、上記のことがまず必要になる。
ーーー
参考までに、
小生が考えた（推察した）のは
（１）入庫日
　　(A)１－１４日まで 1=<ｘ<=14　　　まず、＋１期
(B)１5－月末日まで 1=<ｘ<=　当月末日　まず、＋１期
（２）出庫日
　　　出庫日について、入庫日と同じ。最後に＋１期
（３）月越えの在庫の期間中
　　　1日にはいると＋１期、１５日にはいると＋１期
月末日が、月により、日数字としては変動するのが厄介。
上記のように、入庫日、出庫日は両端入れで良いのかな。両方ともカウント対象にする。
＝＝＝
関数で出来れば、関数でやるべきだが、面倒そうなので、小生なら、ＶＢＡによる関数を組む（ユーザー作成関数）がな。
入庫日・出庫日の、その時の実際のカレンダーに応じて考えなくてはならないので面倒。

補足

有難うございます。
分かり易く書いたつもりでしたが、不慣れですみません。

ほぼご指摘の通りですが、
1-15日　
16日-末日
で分かれます。

入庫日、出庫日とも両端入れです。

また年をまたぐ場合もあります。（2022年12月3日から2023年1月19日　は4期　）

できれば、関数だけの式にしたいのですが、もしアイデア頂ければ幸いです。

ご親切にありがとうございます。

回答No.6

kkkkkm

No.5の補足です。
年をまたいだ場合は正しい値がでません。

補足

ご連絡ありがとうございます。
年内だとうまくいきました。
ありがとうございます。
年をまたいだ計算もしたいのですが、アイデアあればご教示いただきたく、重ねがさねすみません。

回答No.5

kkkkkm

最初に全期分計算して、入庫日が15日を過ぎていれば5を引き、出庫日が15日以内であればさらに5を引くというやり方でいかがでしょう。

「1月13日に入庫して」は「1月16日に入庫して」と考えています。

A1が入庫日
B1が出庫日
として

=((MONTH(B1)-MONTH(A1)+1)*10)-IF(DAY(A1)>15,5,0)-IF(DAY(B1)<=15,5,0)

回答No.4

hiro_1116

＞-1月13日に入庫して　2月5日に出庫　1月後半分と2月前半分の2期分で　10円

1月13日は「1月前半」の日付なのに、どうして1月前半分の料金は掛からないのでしょうか？そのあたりのルールも明確に示してご質問される方が良いように思いました。

補足

申し訳ございません。
書き間違えでした。

-1月13日に入庫して　2月5日に出庫　1月後半分と2月前半分の3期分で　15円

です。
早速のご返信ありがとうございます。