1397013944 消費税計算のマクロ作成をお願いいたします。


消費税を計算するのがややこしくてこまっております。

詳しくは画像をご確認いただきたいのですが、
消費税は1円未満切り捨てでして、ROUNDDOWN(a1*8%,0)で計算したのが左側です。

すると、13円から24円までの間が1円消費税をいただくことになります。
2円いただくのは、25円から37円までの間となります。

これを右側のように一覧表にしたいのです。
A列は1円いただく最初の金額、ハイフンをはさんで右側が1円の最大の金額
B列はその消費税(この場合1円)
行をうつって、2円も同様。次は3円、次は4円・・・・

60行までいくと列がうつります。最大額1万円まで計算していただきたいのですが、
その部分10000はこちらで入れ替えられるようにお願いいたします。

97-2003のエクセルで動くマクロでお願いいたします。

どうかよろしくお願いいたします。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2014/04/09 12:25:44
  • 終了:2014/04/09 15:59:43

ベストアンサー

id:snow0214 No.2

snow0214回答回数470ベストアンサー獲得回数1162014/04/09 14:20:56

ポイント200pt

こんなマクロでどうでしょうか。
変数price_from,price_to,lapel,taxは自由に変更できます。

Sub test()
    Dim price_from, price_to, lapel, r, c As Integer
    Dim tax As Double
    
    price_from = 1              '計算開始価格
    price_to = 10000            '計算終了価格
    lapel = 60                  '折り返し行数
    tax = 0.08                  '税率

    r = 1
    c = 1
    ActiveSheet.Cells.Clear

    '計算開始価格の消費税額
    t0 = 0
    t1 = WorksheetFunction.Round(price_from * tax, 0)
    If (t1 = 0) Then
        s = ""
    Else
        s = price_from & "-"
    End If
    '税額表の作成
    For p = price_from To price_to
        t1 = Application.RoundDown(p * tax, 0)
        '税額を記入
        If (t1 > t0) Then
            If (t0 > 0) Then
                s = s & (p - 1)
                ActiveSheet.Cells(r, c).Value = "'" & s
                ActiveSheet.Cells(r, c + 1).Value = t0
                '折り返すかどうか
                r = r + 1
                If (r > lapel) Then
                    c = c + 2
                    r = 1
                End If
            End If
            s = p & "-"
            t0 = t1
        End If
    Next p
    '最後の処理
    s = s & (p - 1)
    ActiveSheet.Cells(r, c).Value = "'" & s
    ActiveSheet.Cells(r, c + 1).Value = t0
End Sub
id:naranara19

完璧でございました。優しいご回答にも好感が持てました!

2014/04/09 15:59:17

その他の回答(1件)

id:TransFreeBSD No.1

TransFreeBSD回答回数665ベストアンサー獲得回数2672014/04/09 13:44:42

ポイント30pt

A1に下記式を入れて、A列C列にコピーでどうでしょうか。

=ROUNDUP(100/8*B1,0)&"-"&ROUNDUP(100/8*(B1+1),0)-1

[追記]
数が多いとB列D列の入力も面倒でしたね。
B1に下記を入れてA1とセットでコピーしていってください。

=(COLUMN(B1)-2)*30+ROW(B1)
id:naranara19

ありがとうございました!マクロでお願いしていましたが、取り掛かってくださって感謝します。

2014/04/09 15:59:01
id:snow0214 No.2

snow0214回答回数470ベストアンサー獲得回数1162014/04/09 14:20:56ここでベストアンサー

ポイント200pt

こんなマクロでどうでしょうか。
変数price_from,price_to,lapel,taxは自由に変更できます。

Sub test()
    Dim price_from, price_to, lapel, r, c As Integer
    Dim tax As Double
    
    price_from = 1              '計算開始価格
    price_to = 10000            '計算終了価格
    lapel = 60                  '折り返し行数
    tax = 0.08                  '税率

    r = 1
    c = 1
    ActiveSheet.Cells.Clear

    '計算開始価格の消費税額
    t0 = 0
    t1 = WorksheetFunction.Round(price_from * tax, 0)
    If (t1 = 0) Then
        s = ""
    Else
        s = price_from & "-"
    End If
    '税額表の作成
    For p = price_from To price_to
        t1 = Application.RoundDown(p * tax, 0)
        '税額を記入
        If (t1 > t0) Then
            If (t0 > 0) Then
                s = s & (p - 1)
                ActiveSheet.Cells(r, c).Value = "'" & s
                ActiveSheet.Cells(r, c + 1).Value = t0
                '折り返すかどうか
                r = r + 1
                If (r > lapel) Then
                    c = c + 2
                    r = 1
                End If
            End If
            s = p & "-"
            t0 = t1
        End If
    Next p
    '最後の処理
    s = s & (p - 1)
    ActiveSheet.Cells(r, c).Value = "'" & s
    ActiveSheet.Cells(r, c + 1).Value = t0
End Sub
id:naranara19

完璧でございました。優しいご回答にも好感が持てました!

2014/04/09 15:59:17

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません