VLOOKUPやめてFindに変えたけど、上手くいかない(。>ω<。)ノ

先日、頓挫した延滞金計算のユーザー定義関数ですが、モヤモヤするので、もう少しいじってみることにしました。ヾ(o´∀`o)ノ
VLOOKUP関数からOffsetとFind関数へ変更してみました。
端数処理があわなあいのはDo Loop処理で年ごとに切り捨てしていたのを利率が同じ間は日数を加算して、利率が変わったときにまとめて計算しようとしたのですが、うまくいきませんでした。
↓のコードは単にVLOOKUP関数からOffsetとFind関数へ変更しましただけです。
明日(今日)はどこかのサイトで質問してみようと思います。今日はダメダメでした。

注意!バグがのこってます。
Option Explicit

Function YEntai(minou As Long, nouki, keisanbi As Date) As Double
If minou < 2000 Then '未納額が2,000円未満はかからない。
 YEntai = 0
Exit Function
End If
If nouki >= keisanbi Then '納期前はかからない
 YEntai = 0
Exit Function
End If
   Dim Entai As Double '額に千円未満の端数があれば切り捨て
    Entai = WorksheetFunction.RoundDown(minou, -3)
   Dim yokujitu As Date
   yokujitu = nouki + 1
   Dim AddOneMY As Date
 AddOneMY = WorksheetFunction.EDate(yokujitu, 1)
If nouki >= AddOneMY Then '納期限の1ヶ月を経過するまでは別計算。
 YEntai = 0
Exit Function
End If
'///////////////////////////////////////////////////
Dim sNen As Long '一月経過後の年
Dim nNen As Long '納期限の翌日の年
nNen = CLng(Format(yokujitu, "YYYY"))
sNen = CLng(Format(AddOneMY, "YYYY"))
 Dim Yentai1st, rituY As Double
 Dim endbi, kaisibi As Date
 Dim Days As Long
 Dim t1, t2, t3, t4 As Range
 Set t1 = Range("利率設定").Find(What:=sNen)
 kaisibi = t1.Offset(0, 1)
 endbi = t1.Offset(0, 2)
 Days= t1.Offset(0, 3)
 rituY = t1.Offset(0, 5)
If nNen = sNen Then
  If endbi < keisanbi Then
  Days = DateDiff("D", AddOneMY, endbi) + 1
  Yentai1st = Entai * rituY * Days / 365
Else
  If keisanbi < endbi Then
  Days = DateDiff("D", AddOneMY, keisanbi) + 1
  Yentai1st = Entai * rituY * Days / 365
  End If
  End If
 YEntai = Yentai1st
 YEntai = WorksheetFunction.RoundDown(YEntai, 0)
 If YEntai <= 0 Then
     YEntai = 0
 End If
Else
'---1130-1230----------------------------
If Format(yokujitu, "mm") = 12 Then
 YEntai = Entai * rituY * Days / 365
 YEntai = Yentai1st
'----------------------------------------
 Dim sabun12 As Long
 sabun12 = DateDiff("D", kaisibi, AddOneMY)
 Dim sagaku12 As Double
 sagaku12 = Entai * rituY * sabun12 / 365
 YEntai = Yentai1st + sagaku12
 YEntai = WorksheetFunction.RoundUp(YEntai, 0)
 If YEntai <= 0 Then
      YEntai = 0
 End If
 End If
 Set t1 = Nothing
End If
'///////////////////////////////////////////////
'----------複数年の場合(最終年除く)
'///////////////////////////////////////////////
If Format(yokujitu, "YYYY") = Format(keisanbi, "YYYY") Then
Exit Function '滞納期間が一年目未満の場合処理を抜ける。
End If
Set t2 = Range("利率設定").Find(What:=sNen)
 kaisibi = t2.Offset(0, 1)
 endbi = t2.Offset(0, 2)
 Days = t2.Offset(0, 3)
 rituY = t2.Offset(0, 5)

 Dim iNen As Long
 If Format(yokujitu, "mm") = 12 Then
 iNen = CLng(Format(AddOneMY, "YYYY"))
 Else
 iNen = CLng(Format(yokujitu, "YYYY")) + 1
 End If
 Dim eNen As Long
 eNen = CLng(Format(keisanbi, "YYYY"))
 Dim Yentai2nd As Double
'-------------------------------------------------
If kaisibi <= AddOneMY Then
Dim sabun As Long
Dim sagaku As Double
sabun = DateDiff("D", kaisibi, AddOneMY)
sagaku = WorksheetFunction.RoundUp(Entai * rituY * sabun / 365, 0)
End If
Set t2 = Nothing
'++++++++Do Loop処理++++++++++++
Do Until iNen = eNen
 Set t3 = Range("利率設定").Find(What:=iNen)
 kaisibi = t3.Offset(0, 1)
 endbi = t3.Offset(0, 2)
 Days = t3.Offset(0, 3)
 rituY = t3.Offset(0, 5)
  If endbi < keisanbi Then
  Yentai2nd = Entai * rituY * Days / 365
  YEntai = YEntai + Yentai2nd
  End If
  iNen = iNen + 1
  Set t3 = Nothing
Loop
   YEntai = WorksheetFunction.RoundUp(YEntai - sagaku, 0)
   If YEntai <= 0 Then
   YEntai = 0
   End If

'-----------最終年用の処理////////////////////////
Dim Yentai3rd As Double
 Set t4 = Range("利率設定").Find(What:=iNen)
  kaisibi = t4.Offset(0, 1)
  rituY = t4.Offset(0, 5)
   Days = DateDiff("D", kaisibi, keisanbi) + 1
   Yentai3rd = Entai * rituY * Days / 365
   YEntai = YEntai + Yentai3rd - sagaku
   YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
 YEntai = 0
End If
Set t4 = Nothing
End Function
スポンサーサイト

テーマ : エクセル
ジャンル : コンピュータ

延滞金計算のユーザー定義関数 完成しませんでした(っω・`。)

一応、いくつかのバグを修正しましたので未完成品ですが、掲載します。
検証結果はこんな感じです。
kensyou-kekka.jpg
それから、関数しか掲載していませんでしたが、利率表を使って計算させています。当初、何度やっても合わないので利率表を確認したらこちらが間違ってました。(//∇//)
rituXY.jpg

続きを読む

Sub FolderSizeCK()サブフォルダの容量をはかります(*ノ∪`*)

昨日(今朝)20日の記事でふれた、サブフォルダのサイズを調べるマクロです。
メディアにバックアップを取る際、このフォルダとこのフォルダは1枚で焼けるなとか、このフォルダは分割しないと1枚に焼けないなとか、実際に職場でも使っていて結構重宝しています。職場の電算関係の部署が似たようなツールをライブラリに登録していたんですけどバイト単位の表示しかせす、使いづらかったので色んなサイトを参考にして自分で作りました。
お役に立てれば幸いです(*ノ∪`*)


動作確認:OS:Windows7、Windows10/エクセル:2010

Sub FolderSizeCK()
  Dim FolderPath As String
  Dim FSO As Object, f As Variant, cnt As Long
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ChDir ThisWorkbook.Path’Win7ではできたのにWin10ではだめ、なんで?
  Cells.Select
   With Selection
   .Clear
   .ColumnWidth = 8.1
  End With
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   With fd
   .Title = "フォルダを選択してください"
    If .Show = True Then
    FolderPath = .SelectedItems(1)
   End If
   End With
   Set fd = Nothing
   'キャンセル時の処理
   If FolderPath = "" Then
   Exit Sub
   End If
   If FolderPath = "ライブラリ" Then ’Win7用?Win10にはない?
   MsgBox "「ライブラリ」は特殊なフォルダなので選択できません"
   Exit Sub
   End If
 For Each f In FSO.GetFolder(FolderPath).SubFolders
  cnt = cnt + 1
  Columns("A:A").Select
  Selection.NumberFormatLocal = "@" '「0911」が「911」等になるのを防ぐ(さっき追加)
  Cells(cnt, 1) = FSO.GetFolder(f).Name
  Cells(cnt, 2) = FSO.GetFolder(f).Size 'バイト
  Cells(cnt, 3) = FSO.GetFolder(f).Size / 1024 'KB
  Cells(cnt, 4) = FSO.GetFolder(f).Size / 1024 / 1024 'MB
  Cells(cnt, 5) = FSO.GetFolder(f).Size / 1024 / 1024 / 1024 'GB
  Cells(cnt, 6) = FSO.GetFolder(f).DateLastModified
  Next f
 Set FSO = Nothing
 Rows("1:1").Select 'ヘッダーを作成
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 Range("A1") = "サブフォルダ名"
 Range("B1") = "バイト"
 Range("C1") = "KB"
 Range("D1") = "MB"
 Range("E1") = "GB"
 Range("F1") = "最終更新日"
  With Selection
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
  End With
 Range("A1").Select
 Selection.CurrentRegion.Select
 With Selection.Borders
 .LineStyle = True
 End With
 Range("C:E").Select
 Selection.NumberFormatLocal = "0.00" '小数点以下2桁固定
 Range("F:F").Select
 Selection.NumberFormatLocal = "gee.mm.dd(aaa)" '和暦で表示、曜日つき
 Columns("A:F").EntireColumn.AutoFit '列幅のオートフィット
 Range("A1:F1").Select
  With Selection.Interior
  .ColorIndex = 37
  End With
  '並び替え(名前順) Win7では並んだのにWin10では並ばなかったので追記
    Range("A1").Select
    Selection.CurrentRegion.Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Selection.CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     Range("A1").Select ’ついでにフィルターもセット
   Selection.CurrentRegion.Select
   Selection.AutoFilter
   Range("E2").Select
 End Sub

職場がWin7で家がWin10なので動作が少し違いました。
並べ替えがしやすいようフィルターも追加しました。
エクスプローラーと比べると小数点以下の端数があいませんが、メディアに焼くときにフォルダの大まかなサイズを調べるために作ったので勘弁してください。結構役に立つツールです。延滞金のユーザー定義関数より需要があるんじゃないかと思います。

ここを直せば別のところに影響が(つД`)ノ

挫折しました。○| ̄|_、納期限11月30日~12月30日の部分がどうしてもうまくいきません(つД`)ノそれ以外の期間は上手くいっているのですが、延滞金のユーザー定義関数はこれ以上うまくいきません。お手上げです。テストしたケースでは、端数処理(ZEntai)で最終的な金額が正解を出しているので、大きな支障はありません。(´∀`*;)ゞ(いいのか?)システムが出力するcsvファイルは納期限と滞納金額はデータとしてもっているのですが、延滞金のフィールドには「0」がセットされていて未納明細を作成する際、同僚が1件1件延滞金シュミレーションで計算して手入力していたので、もう少し楽にならないかと思い作成しました。エクセルのVBAでCSVを取り込んで、レイアウトを整形(雛形)が作成されるので、現在作成中(多分頓挫)の関数を使って延滞金をセルに表示、システムの延滞金シュミレーションでチェック、違っていたら手入力で修正する手法をとっています。使用するのは端数処理後の数字なので、これまで手入力で修正した例はまだありません。ただ、数円の誤差ですが問題を抱えた関数なので必ずチェックするようにしています。今日、いや昨日も細かいところを修正したのですが、ここをいじるとここは治るが別のところで誤差がでる、イタチゴッコです。

もやもやします(´・ω・`).。oO

11月30日~12月30日納期限の誤差を修正出来ません。_(:□ 」∠)_もやもやします。
|ω・`)↓のコードは8日に掲載したものをいじったものです。納期限が11月30日~12月30日でなければ、ほぼ100%近い(数十件計算例をためしました)正しい答えを出してくれます。納期限が11月30日~12月30日の間も7割がた正解をだすのですが、これがかえって厄介でして、問題箇所を突き止めるのを難しくしています。Q&Aサイトに質問しようと思ったのですが。マルチポストはマナー違反ですし、どこのサイトが良いのか分からないので質問もしてません。水曜日の勤労感謝の日には完成させたいです。こんな面倒なことせっかくの祭日である勤労感謝の日にやる気かとおもわれるかと思いますが、例年、平日、楽するためにプログラムを組む日と自分の中で決めています。昨年はサブフォルダのサイズの一覧を表示させるプログラムを組みました。エクスプローラーはファイルのサイズを表示しますが、フォルダはプロパティで確認するかマウスをフォルダのアイコンにカーソルを合わせるとか、面倒です。データのバックアップの際とか重宝してます。


Option Explicit
Function YEntai(minou As Long, nouki As Date, keisanbi As Date) As Double
If minou < 2000 Then '未納税額が2000円未満なら0円
YEntai = 0
Exit Function
End If
If nouki >= keisanbi Then '納期限前なら当然かからない
YEntai = 0
Exit Function
End If
Dim Entai As Double
Entai = WorksheetFunction.RoundDown(minou, -3) '1000円未満の端数があれば切り捨て
Dim yokujitu As Date
yokujitu = nouki + 1
Dim AddOneMY As Date
AddOneMY = DateAdd("m", 1, yokujitu) '納期限の翌日から1月後の日付を返す。
If yokujitu >= AddOneMY Then '納期限の翌日から一ヶ月を経過する日までは別途計算(XEntai)。
YEntai = 0
Exit Function
End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim sNen, nNen As Long
sNen = CLng(Format(AddOneMY, "YYYY")) '納期限の翌日から1月経過後の年を返す
nNen = CLng(Format(yokujitu, "YYYY")) '納期限の翌日の年を返す
Dim Yentai1st As Double
Dim rituY As Double
Dim kaisibi As Date
Dim endbi As Date
If sNen = nNen Then '(納期限が11月30日~12月30日以外)
rituY = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 6, False)
kaisibi = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 2, False)
endbi = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 3, False)
Dim Days As Long
If endbi < keisanbi Then
Days = DateDiff("D", AddOneMY, endbi) + 1
Yentai1st = Entai * rituY * Days / 365
Else
If keisanbi < endbi Then
Days = DateDiff("D", AddOneMY, keisanbi) + 1
Yentai1st = Entai * rituY * Days / 365
End If
End If
YEntai = Yentai1st
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
'-------------------------------------------------------------------------
Else
GoTo NINENME '悩んだけど結局2年目の処理と同じなので飛ばす。
End If
'-------------2年目以降の処理---------------------------------------------
NINENME:
If Format(yokujitu, "YYYY") = Format(keisanbi, "YYYY") Then
Exit Function '滞納期間が一年目未満の場合処理を抜ける。
End If
'--------------------------------------------------------------------------
Dim iNen As Long
If Format(yokujitu, "mm") = 12 Then '
iNen = CLng(Format(AddOneMY, "YYYY"))
Else
iNen = CLng(Format(yokujitu, "YYYY")) + 1 '一年目処理が終わっているので+1(2年目)
End If
Dim eNen As Long
eNen = CLng(Format(keisanbi, "YYYY")) '最終年
Dim Yentai2nd As Double
kaisibi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 2, False)
rituY = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 6, False)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If kaisibi <= AddOneMY Then
Dim sabun As Long
Dim sagaku As Double
sabun = DateDiff("D", kaisibi, AddOneMY)
sagaku = Entai * rituY * sabun / 365
End If
'+++++++++++Do Loop処理++++++++++++++++++++++++++++++++++++++++++++++

Do Until iNen = eNen
kaisibi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 2, False)
endbi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 3, False)
rituY = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 6, False)
If endbi < keisanbi Then
Days = DateDiff("D", kaisibi, endbi) + 1
Yentai2nd = Entai * rituY * Days / 365
Yentai2nd = WorksheetFunction.RoundDown(Yentai2nd, 0)
YEntai = YEntai + Yentai2nd
End If
iNen = iNen + 1
Loop
If Format(yokujitu, "mm") = 12 Then
YEntai = YEntai
Else
YEntai = YEntai - sagaku
End If
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
'-----------最終年用の処理////////////////////////////////////////////////////////////////
Dim Yentai3rd As Double
kaisibi = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 2, False)
rituY = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 6, False)
Days = DateDiff("D", kaisibi, keisanbi) + 1
Yentai3rd = Entai * rituY * Days / 365
YEntai = YEntai + Yentai3rd - sagaku
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
End Function


続きを読む

延滞金計算ユーザー定義関数の続き(修正です)(;д;)

8日の記事に10日に記事を追記したのですが、追記部分に誤りがあったので修正したいのですが、管理画面から追記部分の編集ができなっかった(記事が長すぎたせい?)なので、追記部分を改めてアップします。
注意:11月30日~12月30日納期限のバグは解消していません。
X:延滞金は納期限の翌日から1ヶ月を経過するまで 
Function XEntai(minou As Long, nouki As Date, keisanbi As Date) As Double


Option Explicit


Function XEntai(minou As Long, nouki As Date, keisanbi As Date) As Double
   If minou < 2000 Or keisanbi <= nouki Then
    XEntai = 0
Exit Function
Else
Dim Entai As Double
Entai = WorksheetFunction.RoundDown(minou, -3)
    End If
Dim yokujitu As Date
yokujitu = nouki + 1
Dim AddOneMX As Date
'AddOneMX = CDate(WorksheetFunction.EDate(yokujitu, 1) - 1)
AddOneMX = DateAdd("m", 1, yokujitu) - 1
Dim iNen, eNen As Long
  iNen = CLng(Format(yokujitu, "YYYY"))
  eNen = CLng(Format(yokujitu, "YYYY") + 1)
Dim rituX, rituX1, rituX2 As Double
Dim Days, Days1, Days2 As Long
Dim endbi, kaisibi As Date
Dim XEntai1, XEntai2 As Double
'----------------------------------------------------------
'1 ヶ月を経過しないときの処理(さらに年をまたぐ場合)
If keisanbi < AddOneMX And iNen < eNen Then
  endbi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 3, False)
   kaisibi = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 2, False)
    Days1 = DateDiff("D", yokujitu, endbi) + 1
    Days2 = DateDiff("D", kaisibi, keisanbi) + 1
  rituX1 = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 5, False)
   rituX2 = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 5, False)
 XEntai1 = WorksheetFunction.RoundDown(Entai * rituX1 * Days1 / 365, 0)
 XEntai2 = WorksheetFunction.RoundDown(Entai * rituX2 * Days2 / 365, 0)
XEntai = XEntai1 + XEntai2
Exit Function
End If
'-----------------------------------------------------------
'1 ヶ月を経過しないときの処理(年をまたがない場合)
If keisanbi <= AddOneMX Then
  Days = DateDiff("D", yokujitu, keisanbi) + 1
  rituX = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 5, False)
  XEntai = WorksheetFunction.RoundDown(Entai * rituX * Days / 365, 0)
Exit Function
End If
'-----------------------------------------------------------
If CLng(Format(yokujitu, "YYYY")) < CLng(Format(AddOneMX, "YYYY")) And AddOneMX < keisanbi Then
   endbi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 3, False)
  kaisibi = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 2, False)
    Days1 = DateDiff("D", yokujitu, endbi) + 1
    Days2 = DateDiff("D", kaisibi, AddOneMX) + 1
  rituX1 = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 5, False)
  rituX2 = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 5, False)
 XEntai1 = WorksheetFunction.RoundDown(Entai * rituX1 * Days1 / 365, 0)
 XEntai2 = WorksheetFunction.RoundDown(Entai * rituX2 * Days2 / 365, 0)
XEntai = XEntai1 + XEntai2
Else
  Days = DateDiff("D", yokujitu, AddOneMX) + 1
    rituX = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 5, False)
  XEntai = WorksheetFunction.RoundDown(Entai * rituX * Days / 365, 0)
End If
End Function

Z:X+Y(端数処理)
Function ZEntai(X As Long, Y As Long) As Long

Option Explicit


Function ZEntai(X As Long, Y As Long) As Long
If X + Y < 1000 Then
ZEntai = 0
Else
ZEntai = WorksheetFunction.RoundDown(X + Y, -2)
End If
End Function


以下、自治体の計算例で同じ答え(正解)が出せた自治体(デバックに使わせて貰った、自治体さん)
Google「延滞金 計算例」で検索して上位に表示された順(計算方法のみで計算例のない自治体さんはスキップ)
・相模原市
・甲府市
・福岡市
・北九州市
・八千代市
以上、Googleの検索結果で1ページ目に表示された自治体さんです。2ページ以降も数件デバックしたんですがリンク貼るの意外と疲れるので今日はここでやめます。
※平成28年11月14日追記
・平塚市
鬼門の11月30日~12月30日納期限の計算例でしたがバグは出ませんでした。たまたまだと思います。
余談ですが、学生時代、大学が平塚市で隣の秦野市に住んでました。懐かしいです。秦野市のHPも覗いて見ましたが計算方法はのっていましたが、計算例は掲載されていませんでした。

8日の記事に追記していたら、日付変わった(;_;)

7,8,9日と3日連続で記事をアップしたので、10日も更新しようとしてたんですけど、8日の記事に追記してたら日付変わってました(´・_・`)
もしよければ、10日に更新した8日の記事の続きを見てもらえれば幸いです。

SONYのMDR-DS7100買いました(#^.^#)

テレビを先月買い換えて4K(UHD)画質を楽しんでいたのですが、どうせなら良い音で聞きたいと思い、SONYのMDR-DS7100買ってみました。7.1chデジタルサラウンド、2.4GHz デジタル無線方式です。
s-MDR-DS7100.jpg
これまでは、同じくSONYの5.1chデジタルサラウンドワイヤレスヘッドホン(型番忘れました)を使っていたのですが経年劣化して5.1chどころか右か左か片方からしか音がです以前から買い換えたいと思っていたので丁度良かったです。
それで、使ってみた感想からいうと経年劣化する前の古いヘッドホンの方が音が良かった感があり微妙な気分です。
それと、WOWOWも契約しているのですが5.1chの番組は放送してますが、7.1chの番組は見かけません。
また自分が持っているBDに7.1chのものはありません。なので、7.1ch対応のコンテンツを試した時でないと比較するのは時期尚早ですね。
 話しは変わりますが今日は歯医者に行って親知らずを抜いて来ました。痛かったです。で、麻酔が効いてるうちはよかったのですが先程から麻酔がキレてジンジンと痛みます。何か意識を痛みからそらさないと堪りません。そんなわけで今記事を書いてます。それでも痛いですギャ─Σ(゜Д゜)Σ(゜Д゜)Σ(゜Д゜)ノノ─ァァァッ!!!
痛みから逃れるため睡眠薬のんでもう寝ます。それでは失礼します。

延滞金計算のユーザー定義関数の作成にチャレンジ♪(o・ω・)ノ))

ビオトープネタばかりなので今日はVBAのことを書きます。
それで、今回は延滞金の計算を楽に出来ないか試してみました。職場のシステムではシュミレータがあるのですが、一件ずつしか処理できませんし、フリーソフトも捜しましたが、28年対応のものは見つかりませんでした。まあ、職場はフリーソフト等の利用はセキュリティ上使っちゃダメってことになっていますし。未納額(minou)、納期限(nouki)、計算日(keisanbi )の3要素があれば、エクセルでユーザー関数を作れるのではないかと思ったのですが、なかなかうまくいきません(;_;)
最初は「Select Case」を使おうと思ったのですが、メンテナンスがメンドクサイことになりそうだったので、シート「利率」テーブル(名前付き「利率設定」)で、VLOOKUPとDo Loop処理でチャレンジしているのですがうまくいきません。
X:延滞金は納期限の翌日から1ヶ月を経過するまで  
Y:延滞金は納期限の翌日から1ヶ月を経過した日から納付の日まで※今回はこれ
Z:X+Y(端数処理)
まず、最初に断っておきますが、下記のユーザー関数は未完成です。納期限が11月30日から12月30日の期間だと数円ずれる場合があります。また、ずれすに正解をだすこともあるので、下手にいじれません。ただ、延滞金のは2つの期間の合計する際、端数処理で100円未満の数値を切り捨てるのでかなりの正解率です、Googleで検索して市町村のHPの延滞金計算例を片っ端からテスト、試した市町村ではすべて正解?を算出できました。ただ、鬼門の納期限が11月30日から12月30日の計算例がなかったので検証がすすみません・゚・(つД`)・゚・もともと、分納や猶予、免除等は無視した代物なのですが。休みの日に素人が暇つぶしに組んでみたVBAなので稚拙なところが多々ありますが、勘弁してください。
また、VBA得意な人で「ここをこう直すと使えるよ」という方かいらっしゃったら
ぜひコメントください。よろしくお願いします。
当ブログのコメントは悪質出会系サイトの誘導1件だけなので寂しいです(´д⊂)
しかも、ひっかかりました(っω・`。)、で関連記事も書いてたんですけど削除しました。(//∇//)
↓コピペしたらタブが消えて見にくいですけどm(_)m


Option Explicit

Function YEntai(minou As Long, nouki As Date, keisanbi As Date) As Double
If minou < 2000 Then '未納税額が2000円未満なら0円
YEntai = 0
Exit Function
End If
If nouki >= keisanbi Then '納期限前なら当然かからない
YEntai = 0
Exit Function
End If
Dim Entai As Double
Entai = WorksheetFunction.RoundDown(minou, -3) '1000円未満の端数があれば切り捨て
Dim yokujitu As Date
yokujitu = nouki + 1
Dim AddOneMY As Date
AddOneMY = DateAdd("m", 1, yokujitu) '納期限の翌日から1月後の日付を返す。
If nouki >= AddOneMY Then '納期限の翌日から一ヶ月を経過する日までは別途計算。
YEntai = 0
Exit Function
End If
'+++++++++++++++++
Dim sNen As Long
Dim nNen As Long
sNen = CLng(Format(AddOneMY + 1, "YYYY")) '納期限の翌日から1月経過後の年を返す
nNen = CLng(Format(yokujitu, "YYYY")) '納期限の翌日の年を返す
Dim Yentai1st As Double
Dim rituY As Double
Dim kaisibi As Date
Dim endbi As Date
If sNen = nNen Then
rituY = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 6, False)
kaisibi = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 2, False)
endbi = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 3, False)
'***************
Dim Days As Long
If endbi < keisanbi Then
Days = DateDiff("D", AddOneMY, endbi) + 1
Yentai1st = Entai * rituY * Days / 365
Else
If keisanbi < endbi Then
Days = DateDiff("D", AddOneMY, keisanbi) + 1
Yentai1st = Entai * rituY * Days / 365
End If
End If
YEntai = Yentai1st
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
'-------------------------
Else
kaisibi = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 2, False)
endbi = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 3, False)
Days = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 4, False)
rituY = WorksheetFunction.VLookup(sNen, Sheets("利率").Range("利率設定"), 6, False)
YEntai = Entai * rituY * Days / 365
YEntai = Yentai1st
'++++++++++++++++
If Format(yokujitu, "mm") = 12 Then '11月30日~12月30日が鬼門
Dim sabun2 As Long
Dim sagaku2 As Double
sabun2 = DateDiff("D", kaisibi, AddOneMY)
sagaku2 = Entai * rituY * sabun2 / 365
YEntai = Yentai1st + sagaku2 '- じゃなく + にしたら数字があった?自分でも謎
End If
'+++++++++++++++++
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
End If
'-------------2年目以降の処理------------------
If Format(yokujitu, "YYYY") = Format(keisanbi, "YYYY") Then
Exit Function '滞納期間が一年目未満の場合処理を抜ける。
End If
'----------------------------------------------
Dim iNen As Long
iNen = CLng(Format(yokujitu, "YYYY")) + 1 '一年目処理が終わっているので+1(2年目)
Dim eNen As Long
eNen = CLng(Format(keisanbi, "YYYY"))
Dim Yentai2nd As Double
kaisibi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 2, False)
rituY = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 6, False)
'++++++++++++++++++++++++++++++++++
If kaisibi <= AddOneMY + 1 Then
Dim sabun As Long
Dim sagaku As Double
sabun = DateDiff("D", kaisibi, AddOneMY)
sagaku = Entai * rituY * sabun / 365
End If
'+++++++++++Do Loop処理+++++++++++++

Do Until iNen = eNen
kaisibi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 2, False)
endbi = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 3, False)
rituY = WorksheetFunction.VLookup(iNen, Sheets("利率").Range("利率設定"), 6, False)
If endbi < keisanbi Then
Days = DateDiff("D", kaisibi, endbi) + 1
Yentai2nd = Entai * rituY * Days / 365
Yentai2nd = WorksheetFunction.RoundDown(Yentai2nd, 1)
YEntai = YEntai + Yentai2nd
End If
iNen = iNen + 1
Loop
YEntai = YEntai - sagaku
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
'-----------最終年用の処理//////////////
Dim Yentai3rd As Double
kaisibi = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 2, False)
rituY = WorksheetFunction.VLookup(eNen, Sheets("利率").Range("利率設定"), 6, False)
Days = DateDiff("D", kaisibi, keisanbi) + 1
Yentai3rd = Entai * rituY * Days / 365
YEntai = YEntai + Yentai3rd - sagaku
YEntai = WorksheetFunction.RoundDown(YEntai, 0)
If YEntai <= 0 Then
YEntai = 0
End If
End Function


ENTAI1.jpg

次は福岡市の計算例でデバッグ

ENTAI2.jpg
ENTAI3.jpg

このように、11月30日~12月30日が納期限以外の場合は上手く計算できるのですが・・・謎です。
この部分のバグが直ったらまた報告します。

続きを読む

テーマ : エクセル
ジャンル : コンピュータ

REGZA-40M500Xが家に来て1ヶ月…

REGZA-32ZP2からREGZA-40M500Xに買い換えて1月が過ぎました、画質はテレビ側での4Kアプコンがおもったよりも優秀で、フルHDで収録されたコンテンツであればかなり綺麗に視聴できるので十分満足です。
ただ、2画面や3Dが無くなったり、パワーダウンしたところもあります。まあ、2画面や3Dは不要な機能と思っていたのでいいのですが、ノートPCとテレビをHDMI接続したときに、ZP2はフルHDのモニターとして使えたのですが、M500Xは1366×768より解像度が上がらずぼやけた感じで残念です。
閲覧者数
訪問者数
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はビオトープ、好きな小説は物語シリーズです。あと、仕事で楽したい(良く言えば効率化)ためにExcelやAccessでVBAをちょくちょくいじってます。
 当ブログはリンクフリーです、コメント頂ければこちらからもリンクさせて頂きます!よろしくお願いします。

最新記事
カテゴリ
カレンダー
10 | 2016/11 | 12
- - 1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 - - -
月別アーカイブ
にほんブログ村
観賞魚ブログ メダカへ
アクセスランキング
[ジャンルランキング]
アニメ・コミック
12558位
アクセスランキングを見る>>

[サブジャンルランキング]
アニメ
3748位
アクセスランキングを見る>>
最新コメント
ミナミヌマエビ
にほんブログ村
検索フォーム
リンク
RSSリンクの表示
ブロとも申請フォーム

この人とブロともになる