マクロ家計簿77/イオンの5%引き対応のマクロを作ったが使いものにならないようだ


 右図は○月○日 イオンの 5%引きの日のレシート。

  • 例えば1行目、(a)価格は 444円。(b) 5%引きで -24円。従って、(c)支払金額は 444−24=420円となる。
  • 5%の値 24円は、444×0.05=22.2円なので計算が合わない。
    この444円の内訳は 148円×3点。で、148×0.05=7.4円 ‥‥ 切り上げて8円。8×3点=24円という計算をしているようだ。
  • この(c)の合計が最下行の 1,783円となる。

 私が困ったのは、全体としての費目は「食費」だが、お酒は「嗜好品」としている点。
家計簿77への支出、

費目入金支出
嗜好品   928
食費 *1 855

が使えないのだ。
 下表のように入力したいのだが‥‥

費目入金支出
嗜好品 47928
食費*2 51*3 953

    1. 928+953=1,881円財布から出たが、
    2. 5%引きなので 47+51=98円財布に戻ってきた。
    3. 実質出費は、1881−98=1,783円。

 とりあえず、928円と953円を入力し、支払金額 1783円円を入力すれば自動的に「入金」が入るマクロを作ったが、丸一日、頭の体操にはなったが「売れない商品を作った」ようだ...

  1. Public Sub ad_選択した支出セルの5pctを入金セルに入れる()
  2. On Error GoTo Err_選択した支出セルの5pctを入金セルに入れる
  3. Const dblPct As Double = 5   '割引率(5%)
  4. Dim mbTitle As String
  5. Dim i As Long, zeroCTR As Long
  6. Dim lng前支出 As Long, lng後支出 As Long, ssRow As Long
  7. Dim lng入金 As Long, lng支払金額 As Long
  8. Dim col支出 As Long, col入金 As Long, col備考 As Long
  9. Dim sum前支出 As Long, sum後支出 As Long, sum入金 As Long
  10.  
  11. mbTitle = "選択した支出セルの5pctを入金セルに入れる/" & getMacroTitle()
  12. If Selection.Count = 0 Then
  13. MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
  14. & "5%引きしたセル(支出金額)が選択されていません。" _
  15. , vbCritical, mbTitle
  16. Exit Sub
  17. End If
  18. If Selection(1).Column <> Selection(Selection.Count).Column Then
  19. MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
  20. & "「支出」のセルのみ選択してください。" _
  21. , vbCritical, mbTitle
  22. Exit Sub
  23. End If
  24. STRAns = Cells(1, Selection(1).Column).Value
  25. If STRAns = "支出" Then
  26. col支出 = getフィールドColumn(1, "支出")
  27. Else
  28. col支出 = 0
  29. End If
  30. col入金 = getフィールドColumn(1, "入金")
  31. col備考 = getフィールドColumn(1, "備考")
  32. If col支出 = 0 Or col入金 = 0 Or col備考 = 0 Then
  33. MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
  34. & "「支出」が選択されていないか、「入金」,「備考」の列が見つかりません。" _
  35. , vbCritical, mbTitle
  36. Exit Sub
  37. End If
  38. sum前支出 = 0
  39. For i = 1 To Selection.Count
  40. VARAns = Selection(i)
  41. If (VARAns = "") Or (IsNumeric(VARAns) = False) Or (VARAns = 0) Then
  42. MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
  43. & " ■セルの値(" & i & ")=" & VARAns & vbCrLf & vbCrLf _
  44. & "「数値以外」または「ゼロ」(空白を含む)のセルがあります。" _
  45. , vbCritical, mbTitle
  46. Exit Sub
  47. End If
  48. sum前支出 = sum前支出 + Val(VARAns)
  49. Next
  50. LNGAns = Fix(sum前支出 * (1 - dblPct / 100))
  51. VARAns = InputBox("支払合計金額を入力してください。", mbTitle, LNGAns)
  52. If VARAns = "" Then Exit Sub
  53. lng支払金額 = Val(VARAns)
  54. If MsgBox("選択したセルの5%引き値を「値引き前」に戻し、5%分「入金」があったように変更します。" & vbCrLf & vbCrLf _
  55. & " ■選択したセル数=" & Selection.Count & vbCrLf _
  56. & " ■値引き前合計金額=" & sum前支出 & vbCrLf _
  57. & " ■支払金額=" & lng支払金額 & vbCrLf _
  58. & " ■値引き(入金額)=" & sum前支出 - lng支払金額 & vbCrLf & vbCrLf _
  59. & "・入金欄に5%分の金額が入ります。" & vbCrLf _
  60. & "・備考欄に「5%引き」の文字が入ります。" & vbCrLf _
  61. & "・誤差は最後の項目で補正されます。" _
  62. , vbOKCancel + vbQuestion, mbTitle) = vbCancel Then
  63. Exit Sub
  64. End If
  65. sum後支出 = 0: sum入金 = 0
  66. ssRow = Selection(1).Row
  67. For i = 1 To Selection.Count
  68. lng前支出 = Selection(i)
  69. lng入金 = Fix(lng前支出 * dblPct / 100 + 0.9)
  70. lng後支出 = lng前支出 - lng入金
  71. sum後支出 = sum後支出 + lng後支出
  72. If i = Selection.Count Then
  73. Cells(ssRow, col入金) = sum前支出 - lng支払金額 - sum入金
  74. Else
  75. Cells(ssRow, col入金) = lng入金
  76. End If
  77. STRAns = Cells(ssRow, col備考).Value
  78. Cells(ssRow, col備考) = "5%引き"
  79. If STRAns <> "" Then Cells(ssRow, col備考) = Cells(ssRow, col備考) & "/" & STRAns
  80. sum入金 = sum入金 + lng入金
  81. ssRow = ssRow + 1
  82. Next
  83.  
  84. Exit_選択した支出セルの5pctを入金セルに入れる:
  85. Exit Sub
  86.  
  87. Err_選択した支出セルの5pctを入金セルに入れる:
  88. MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
  89. Resume Exit_選択した支出セルの5pctを入金セルに入れる
  90. End Sub

*1:=1783-928

*2:=24+10+6+4+7

*3:=444+198+116+68+127