VBA 税率を判定表する方法を教えて下さい。

Question

請求書(sheet21)に税率(10又は８)を表示したく、添付したコードを作成したのですが作動しません。また、ディバックも表示されず、原因がわかりません。作成したコードは、Sheet21のＢ16～Ｂ23セルに商品コード100～1000及びSK01～SK200から商品名に応じた８個の商品コードを入力し、N16～N23セルに、100～1000までは「１0」を SK01～SK200までは「８」を表示すると思ったのですが、素人では無理でした。
Sub 消費税率判定()
  Dim n As Long
  Dim Sh21 As Worksheet
  Dim i As Integer
  Set Sh21 = Worksheets("b16:N23")
  n = WorkSheetFanction("sh21").CountIf(Range("B16:N23"), "<>")
  For i = 100 To 1000
  Next
  
  If Sh21.Range("B16:B23").Value = i Then
  Range("N16:N23").Value = 10
  Else
  Range("N16:N23").Value = 8
 
  MegBox ("税率は正しいですか")
  
  End If
    
End Sub

naktak · Accepted Answer

消費税を算出する処理にセル情報は無関係なので別関数にしましょう。
また、100未満、1000超、1未満、200超、数値でない可能性を考慮し、エラーハンドリングをしましょう。

Option Explicit

'
' 消費税エリアを処理します。
'
Public Sub 消費税率判定()
    On Error GoTo Exception
    
    Dim sheet As Worksheet
    Dim itemCodeRanges As Range
    Dim itemCodeRange As Range
    
    Set sheet = Worksheets("請求書")
    Set itemCodeRanges = sheet.Range("B16:B23")
    
    ' 消費税列をクリア
    itemCodeRanges.Offset(, 12).Value = vbEmpty
    
    ' 消費税を設定
    For Each itemCodeRange In itemCodeRanges
        itemCodeRange.Offset(, 12).Value = getTax(itemCodeRange.Value)
    Next
    Call MsgBox("税率は正しいですか")
    Exit Sub
    
Exception:
    Call MsgBox(Err.Number & vbCrLf & Err.Description, vbOKOnly + vbCritical, "エラー")
End Sub

'
' 消費税を求める。
' @param itemCode 商品コード。
' @return 消費税。
'
Private Function getTax(itemCode As String) As Long
    On Error GoTo Exception
    
    Const ReducedTaxRateItemPrefix As String = "sk"
    
    ' 消費税範囲グループ
    Dim taxGroups(1) As Variant
    taxGroups(0) = Array(100, 1000, 10)
    taxGroups(1) = Array(1, 200, 8)
    
    Dim targetItemCode As String
    targetItemCode = LCase(itemCode)
    
    ' 消費税範囲を特定
    Dim tax() As Variant
    If InStr(targetItemCode, ReducedTaxRateItemPrefix) = 0 Then
        tax = taxGroups(0)
    Else
        tax = taxGroups(1)
    End If
    
    ' 消費税の決定
    Dim itemCodeNumber As Long
    itemCodeNumber = CLng(Replace(targetItemCode, ReducedTaxRateItemPrefix, ""))
    If tax(0) <= itemCodeNumber And itemCodeNumber <= tax(1) Then
        getTax = tax(2)
        Exit Function
    End If
    
    Call Err.Raise(1000)
    Exit Function
    
Exception:
    Call Err.Raise(Err.Number, Err.Source, "消費税算出できませんでした。" & vbCrLf & Err.Description, Err.HelpFile, Err.HelpContext)
End Function

naktak · Answer

なるほど、失礼しました。
Qchan1962様のおっしゃる通りですね。
では、getTax()に渡す商品コードを得ることができないなら、処理を終わらすなどすれば良さそうですね。

質問者様の全体的な処理の流れが分かりませんが、入力された行ずつに何かを処理しているなら、そこにgetTax()を混ぜ込んで処理することでも可能でしょう。

Qchan1962 · Answer

すみません。少しお借りします
naktak様　請求書と言う事で必ず範囲が埋まっているとは限らないと思います。
従って、空白セルに対しての処理が必要になると思いますが・・
違っていたらごめんなさい。

naktak · Answer

全角数字でも入ってるんじゃないですか？
そのエラーはSKを除いた値が数値に変換できないから出てますので。

Qchan1962 · Answer

ご質問の回答ではありませんが本来は、請求書に直接入力を行って処理するのはどうなのかなと思います出来るだけ元データ（作成するためのデータ）は、一元化するのが良いと思います。受注ー＞納品ー＞請求　みたいに1つ前のデータで作られる形と考えると受注データを入力、納品データを操作して請求書を作る流れになるかと・・なので、商品一覧表を基軸に考えた方が品番はもちろん品名や単価A・B・C税率など操作し易くなると思いました。他にも顧客一覧（情報）などが必要ですし、（実績）蓄積データも必要かとそう考えると基幹業務をVBAで作成するには、少しスキルが必要になるのかなと思いました。この回答に逆行するような回答ですが、 B列入力時に出力してしまう　と言う方法も考えられます。（私的には比較的よく使います（処理速度をごまかす為）受注入力などで使えると思います）一応、コードです。対象のシートモジュールに記載しますがすでにWorksheet_Changeイベントを使われている場合は使われている Worksheet_Change内に組み込む必要があります。（サンプルなので少しやっつけ感ありますが添削してくださいね）当然あるであろう値の削除、選択範囲に入力していくような手順にも取り合えず対応してみました。（該当品番以外を入力するとメッセージ出力後、元の値に戻ります） Option Explicit Dim flag As Boolean Const iKey As String = "sk" Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range flag = False If Intersect(Target, Range("B16:B23")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Count > 1 Then For Each r In Selection Call process1(r) Next Else Call process1(Target) End If If flag = False Then MsgBox ("登録品番では有りません") Application.Undo End If Application.EnableEvents = True End Sub Sub process1(Target As Range) With Target If .Value = "" Then .Offset(, 12).Value = "": flag = True: Exit Sub If InStr(.Value, iKey) = 0 Then If .Value >= 100 And .Value <= 1000 Then .Offset(, 12).Value = 10: flag = True Else If CInt(Split(.Value, iKey)(1)) >= 1 And CInt(Split(.Value, iKey)(1)) <= 200 Then .Offset(, 12).Value = 8 flag = True End If End If End With End Sub ここ迄書いて思いました。ひょっとしてB列の値は入力では無いですね多分。それはそうですよね。。。入力でなければ、意味ないですね。。まぁ、せっかく？書いたので掲示します。

Qchan1962 · Answer

添付図を掲示される前に作成したコードなので
条件が質問文にある　SK　大文字　となっています
図のように　skとするといかがでしょうか
修正箇所　If InStr(r, "SK") = 0 Then　など　3か所
このキーが変わらない場合は以上で良いと思いますが、

全角半角、大文字小文字が混在するような場合、
右辺と左辺を同じにして比較する必要がありますので
大文字か小文字にUCase関数　LCase関数などで合わせます
また、全角半角なども処理上、合わせる場合、StrConv関数を使用します
上記関数については
UCase関数　LCase関数　StrConv関数、などで調べてみてください。

Qchan1962 · Answer

連投すみません
＞その都度請求する品目数が８品目以内と少ないので、商品コードはコード一覧表から手入力しています。

そっちでなく、条件を一覧表から取得した方が良くないかなぁ　と思いました
また、一覧表があるなら、そこに税率項目を設定して
Vlookupなどの関数でも良さそうですが、VBAは他の処理も同時に出来るので、そのあたりの処理方法は何かを推奨する訳ではありません

Qchan1962 · Answer

＃２です
訂正です　　If r >= 1 And ではなく　If r >= 100 And ですね

Qchan1962 · Answer

こんにちはコードとご説明から推測すると Sub 消費税率判定() Dim Sh21 As Worksheet Dim Rng As Range Dim r As Range Set Sh21 = Worksheets("請求書") Set Rng = Sh21.Range("B16:B23") For Each r In Rng If InStr(r, "SK") = 0 Then If r >= 1 And r <= 1000 Then r.Offset(, 12).Value = 10 Else If CInt(Split(r, "SK")(1)) >= 1 And CInt(Split(r, "SK")(1)) <= 200 Then r.Offset(, 12).Value = 8 End If End If Next MsgBox ("税率は正しいですか") End Sub ちょっと分かりにくい書き方で申し訳ないのですが、こんな感じかな？商品コードはVBA内で設定していますが、実際にはシートに書いてあるのではないかと・・

よろずやkinchan · Answer

コードは無視します。
シートのどこに何があるかを、正確に記述してください。
図を添付していただけると尚いいです。

VBA 税率を判定表する方法を教えて下さい。

消費税を算出する処理にセル情報は無関係なので別関数にしましょう。

なるほど、失礼しました。

すみません。

全角数字でも入ってるんじゃないですか？

ご質問の回答ではありませんが

添付図を掲示される前に作成したコードなので

連投すみません

＃２です

こんにちは

コードは無視します。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング