- 例えば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 |
下表のように入力したいのだが‥‥
費目 | 入金 | 支出 |
---|---|---|
嗜好品 | 47 | 928 |
食費 | *2 51 | *3 953 |
-
- 928+953=1,881円財布から出たが、
- 5%引きなので 47+51=98円財布に戻ってきた。
- 実質出費は、1881−98=1,783円。
とりあえず、928円と953円を入力し、支払金額 1783円円を入力すれば自動的に「入金」が入るマクロを作ったが、丸一日、頭の体操にはなったが「売れない商品を作った」ようだ...
- Public Sub ad_選択した支出セルの5pctを入金セルに入れる()
- On Error GoTo Err_選択した支出セルの5pctを入金セルに入れる
- Const dblPct As Double = 5 '割引率(5%)
- Dim mbTitle As String
- Dim i As Long, zeroCTR As Long
- Dim lng前支出 As Long, lng後支出 As Long, ssRow As Long
- Dim lng入金 As Long, lng支払金額 As Long
- Dim col支出 As Long, col入金 As Long, col備考 As Long
- Dim sum前支出 As Long, sum後支出 As Long, sum入金 As Long
- mbTitle = "選択した支出セルの5pctを入金セルに入れる/" & getMacroTitle()
- If Selection.Count = 0 Then
- MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
- & "5%引きしたセル(支出金額)が選択されていません。" _
- , vbCritical, mbTitle
- Exit Sub
- End If
- If Selection(1).Column <> Selection(Selection.Count).Column Then
- MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
- & "「支出」のセルのみ選択してください。" _
- , vbCritical, mbTitle
- Exit Sub
- End If
- STRAns = Cells(1, Selection(1).Column).Value
- If STRAns = "支出" Then
- col支出 = getフィールドColumn(1, "支出")
- Else
- col支出 = 0
- End If
- col入金 = getフィールドColumn(1, "入金")
- col備考 = getフィールドColumn(1, "備考")
- If col支出 = 0 Or col入金 = 0 Or col備考 = 0 Then
- MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
- & "「支出」が選択されていないか、「入金」,「備考」の列が見つかりません。" _
- , vbCritical, mbTitle
- Exit Sub
- End If
- sum前支出 = 0
- For i = 1 To Selection.Count
- VARAns = Selection(i)
- If (VARAns = "") Or (IsNumeric(VARAns) = False) Or (VARAns = 0) Then
- MsgBox "[選択した支出セルの5pctを入金セルに入れる]に失敗しました。" & vbCrLf & vbCrLf _
- & " ■セルの値(" & i & ")=" & VARAns & vbCrLf & vbCrLf _
- & "「数値以外」または「ゼロ」(空白を含む)のセルがあります。" _
- , vbCritical, mbTitle
- Exit Sub
- End If
- sum前支出 = sum前支出 + Val(VARAns)
- Next
- LNGAns = Fix(sum前支出 * (1 - dblPct / 100))
- VARAns = InputBox("支払合計金額を入力してください。", mbTitle, LNGAns)
- If VARAns = "" Then Exit Sub
- lng支払金額 = Val(VARAns)
- If MsgBox("選択したセルの5%引き値を「値引き前」に戻し、5%分「入金」があったように変更します。" & vbCrLf & vbCrLf _
- & " ■選択したセル数=" & Selection.Count & vbCrLf _
- & " ■値引き前合計金額=" & sum前支出 & vbCrLf _
- & " ■支払金額=" & lng支払金額 & vbCrLf _
- & " ■値引き(入金額)=" & sum前支出 - lng支払金額 & vbCrLf & vbCrLf _
- & "・入金欄に5%分の金額が入ります。" & vbCrLf _
- & "・備考欄に「5%引き」の文字が入ります。" & vbCrLf _
- & "・誤差は最後の項目で補正されます。" _
- , vbOKCancel + vbQuestion, mbTitle) = vbCancel Then
- Exit Sub
- End If
- sum後支出 = 0: sum入金 = 0
- ssRow = Selection(1).Row
- For i = 1 To Selection.Count
- lng前支出 = Selection(i)
- lng入金 = Fix(lng前支出 * dblPct / 100 + 0.9)
- lng後支出 = lng前支出 - lng入金
- sum後支出 = sum後支出 + lng後支出
- If i = Selection.Count Then
- Cells(ssRow, col入金) = sum前支出 - lng支払金額 - sum入金
- Else
- Cells(ssRow, col入金) = lng入金
- End If
- STRAns = Cells(ssRow, col備考).Value
- Cells(ssRow, col備考) = "5%引き"
- If STRAns <> "" Then Cells(ssRow, col備考) = Cells(ssRow, col備考) & "/" & STRAns
- sum入金 = sum入金 + lng入金
- ssRow = ssRow + 1
- Next
- Exit_選択した支出セルの5pctを入金セルに入れる:
- Exit Sub
- Err_選択した支出セルの5pctを入金セルに入れる:
- MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
- Resume Exit_選択した支出セルの5pctを入金セルに入れる
- End Sub