[ExcelVBA] 税込み価格への修正

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧

■お題
税込み価格への修正(問題出典：どう書く？org)
- 問題詳細 -

ここにチラシの原稿があります。例えば「ダイコン150円、ハクサイ120円、ジャガイモ30円」のような文字列です。法改正によって商品の値段は税込み表示にしないといけなくなりました。そこで、与えられた文字列の中から税抜き価格を見つけ出し、税込み価格に変更した文字列を返す関数を作ってください。
なお、税抜き価格は半角の数字の連なりで、かつ半角の数字の連なりはすべて税抜き価格だとします。「9,800円」「百円」「１００円」「100g80円」などのような記述はないと考えてかまいません。 また税込み価格は税抜き価格の1.05倍で、端数は切り捨てとしてください。

■解答例
正規表現を使う問題ですね。
問題文は、親切でとてもやさしいものとなっています。
他の言語であれば置換する時にマッチしたデータに対し計算を施した結果を置換することができるのに
対しExcelVBAではできないようなので、ちょっと発想の転換が必要なのかもしれません。


では、コードです。

Option Explicit

Function ExchangeValue(Str As String)
    Dim Reg As Object, result As Object
    Set Reg = CreateObject("VBScript.RegExp")
    
    Reg.Pattern = "\d+"
    Reg.Global = True
    
    Set result = Reg.Execute(Str)
    Dim i As Integer
    For i = result.Count - 1 To 0 Step -1
        With result.Item(i)
            Str = Left(Str, .FirstIndex - 1) & Replace(Str, .Value, CInt(.Value) * 1.05, Start:=.FirstIndex)
        End With
    Next
    
    ExchangeValue = Str
End Function

３行目：引数に変更する文章をうけとるStrを用意してあります。
４行目：変数Regは正規表現のオブジェクトを格納するよう。
変数resultは、正規表現の結果を格納するよう。
５行目：正規表現のオブジェクトを生成

７行目：正規表現を指定。今回は「数字が１つ以上続く」を指定
８行目：複数回出てくることを想定してGlobalプロパティをTrue

１０行目：正規表現の結果を格納
１１行目：変数i For文内で配列のインデックスとして使用
１２行目：For文：マッチした正規表現の回数文ループ。
１３行目：正規表現の結果のオブジェクトが長かったんで、Withでくくりだしています。
End Withまでは、以降 .で始まる文字列は、result.Item(i)が省略されてます
１４行目：Replace関数の引数にStartオプションを使うとそれより前の文字列は返されません。
よって、全文取得するため、Startオプションより前をLeft関数で取得しています。
Replaceする内容は、１０行で実行した正規表現の結果をもとに連続する数字を
1.05倍したものと置換していきます。
１５行目：Withを終了
１６行目：繰り返し

１８行目：変換した文字列を返す

実際にこんな感じで使う

Option Explicit

Sub main()
    Dim Str As String
    Str = "「ダイコン150円、ハクサイ120円、ジャガイモ30円」"
    
    Debug.Print ExchangeValue(Str)
End Sub

実行結果
「ダイコン157.5円、ハクサイ126円、ジャガイモ31.5円」

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧