[[20210225190822]] 『文字列から』(BLC眼鏡) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『文字列から』(BLC眼鏡)

電話販売のコールセンター業務をしております。
お客様に商品をご案内する際のテキストがエクセル管理されているのですが、文字列と数字が規則性なく並んでいる単なる文章です。


(例)
ハンカチ2枚セットが20%オフで今なら3000円引きの¥2000です!
5cmの厚みのゲルママットが¥1,000円割引!お得な900円でのご案内

このような内容を、金額の部分だけ税込表示(つまり1.1倍)したいです。


(したい変更)
ハンカチ2枚セットが20%オフで今なら3300円引きの¥2200です!
5cmの厚みのゲルママットが¥1100円割引!お得な990円でのご案内

金額には、前に「¥」「\」又は後ろに「円」が必ずついていることがわかったので、[,]は削除し、全角数字/文字列は全て半角に変換すれば
”前に[\]又は後ろに[円]が付いた数字を1.1倍して戻す”
処理ができれば問題ないのですが、そのようなことを実現する関数、方法はありますでしょうか。

文字列から特定の条件で数字を抜き出す。くらいなら近しい関数を解説しているページをいくつか見つけたのですが
それを1.1倍して戻すとなるとわからず質問させていただきました。

何卒よろしくお願いいたします。

< 使用 Excel:Office365、使用 OS:Windows10 >


なぜか回答がつかないですね。

正規表現がよいのでしょうが、わたしには使いこなせないので
たまにはワードマクロで。

>[,]は削除し、全角数字/文字列は全て半角に変換すれば

それでもよいのなら、こんな感じ。

 Option Explicit

 Sub test()
    Dim r As Range
    Dim s As String

    Set r = ActiveDocument.Range

    r.Font.Color = vbBlack

    With r.Find
         .MatchWildcards = True
        .ClearFormatting
        .Replacement.ClearFormatting

        .Text = "[0-90-9,,]{1,}円"
        .Replacement.Font.Color = vbRed
        .Execute Replace:=wdReplaceAll, Format:=True

        .Text = "[\\¥][0-90-9,,]{1,}"
       .Execute Replace:=wdReplaceAll, Format:=True

       .Font.Color = vbRed
       .Text = "[0-90-9,,]{1,}"

        Do While .Execute
            r.CharacterWidth = wdWidthHalfWidth
            s = r.Text
            If InStr(s, ",") Then
                r.Text = Replace(s, ",", "")
                r.Collapse wdCollapseStart
            Else
                r.Text = CInt(s) * 1.1
                r.Collapse wdCollapseEnd
            End If
        Loop
    End With

    ActiveDocument.Range.Font.Color = vbBlack

 End Sub

(マナ) 2021/03/02(火) 23:02


 遅ればせながら、正規表現を使ったコードを書いてみました。

 (変換前)
 ハンカチ2枚セットが20%オフで今なら3000円引きの¥2000です!
 5cmの厚みのゲルママットが¥1,000円割引!お得な900円でのご案内
 (変換後)
 ハンカチ2枚セットが20%オフで今なら3,300円引きの\2,200です!
 5cmの厚みのゲルママットが\1,100円割引!お得な990円でのご案内

 【使い方】
 標準モジュールに
 ・myConvert
 ・addTax
 の二つをコピーして下さい。

 myConvert(変換前文字列)とすると、
 変換後の文字列が返されますので、
 あなたのコードに組み込んで見て下さい。

 【参考コード】
 Sub test()      '検証用のコードです。
     Dim s As String
     s = "ハンカチ2枚セットが20%オフで今なら3000円引きの¥2000です!"
     s = s & vbLf & "5cmの厚みのゲルママットが¥1,000円割引!お得な900円でのご案内"

     Debug.Print s
     Debug.Print myConvert(s)
 End Sub

 Function myConvert(s As String) As String
     Dim Matches     As Object
     Dim m           As Object
     Dim matchStr    As String
     Dim replaceStr  As String
     Dim k           As Long
     Dim i           As Long
     Dim cond1       As String
     Dim cond2       As String
     Dim e           As Variant

     s = Replace(s, "¥", "\") 'StrConvですべて半角にすると
                               'カタカナも対象になるのでまずい。
                               '¥は数値とのバランス上、半角が不可避と思料。
     With CreateObject("VBScript.RegExp")
         cond1 = "\\([\d0-9,]+)"
         cond2 = "([\d0-9,]+)(?=円)"
         .Pattern = cond1 & "|" & cond2
         .Global = True
         Set Matches = .Execute(s)

         For k = Matches.Count - 1 To 0 Step -1
             Set m = Matches.Item(k)
             i = m.FirstIndex               'マッチした文字列の開始位置
             For Each e In m.SubMatches
                 If Len(e) > 0 Then
                     matchStr = e           'マッチした数字
                     replaceStr = addTax(e) '税込み変換後の数値
                 End If
             Next
             '文字列の最後尾から前に向かって、しかも一箇所だけ置換する
             s = Left(s, i) _
                 & Replace(s, matchStr, replaceStr, i + 1, 1)
         Next
         myConvert = s
     End With
 End Function

 Private Function addTax(s As Variant) As String
     Dim v As Long
     v = CLng(s)
     addTax = Format(1.1 * v, "#,##0")  '変換後をカンマ付きにする
     'addTax = CStr(1.1 * v)            '変換後をカンマ付きにしない
 End Function

 myConvertの中で逐一正規表現オブジェクトの作成(とパターン指定)をしていますので、
 メインの中で一度だけ実行すると良いかもしれません。
 ただ、今のものでもそう致命的に速度が低下することは無いと思います。

 【補足】
 正規表現を備えた言語では、普通は変換後の文字列をもっと柔軟に、もっと容易に指定できるのですが、
 VBScriptのそれは、極めて使い勝手が悪いです。
 そこで、
 ・置換は、文字列の後ろから実行することで変換に伴う位置の変化が
   後続処理に影響しないようにしています。
 ・また、Replaceはあえて、マッチしたものを一つだけ置換するようにして、
   不測の誤変換を避けるようにしています。

 VBScriptの正規表現を使った、少し複雑な置換は、
 こうした手法に依らざるを得ないのではないかと思っています。

(γ) 2021/03/03(水) 11:09


γさん、ありがとうございます。
回答していただけると思っていました。

 γさんのを真似て,少しだけ修正
 1)\を半角に置換
 2)数値の書式はカンマ付き
 3)CIntをCLng

 と修正しました。

 あと、実行後は確認しやすいと思うので
 せっかくつけた赤字は、そのままにしました。
 黒字にするのは手作業でも簡単なので。

 Sub test2()
    Dim r As Range
    Dim s As String

    Set r = ActiveDocument.Range
    r.Font.Color = vbBlack

    With r.Find
         .MatchWildcards = True
        .ClearFormatting
        .Replacement.ClearFormatting

        .Text = "[0-90-9,,]{1,}円"
        .Replacement.Font.Color = vbRed
        .Execute Replace:=wdReplaceAll, Format:=True

        .Text = "[\\¥]([0-90-9,,]{1,})"
        .Replacement.Text = "^92\1"
        .Execute Replace:=wdReplaceAll, Format:=True

        .Font.Color = vbRed
        .Text = "[0-90-9,,]{1,}"
        .Replacement.Text = ""
        Do While .Execute
            r.CharacterWidth = wdWidthHalfWidth
            s = r.Text
            If InStr(s, ",") Then
                r.Text = Replace(s, ",", "")
                r.Collapse wdCollapseStart
            Else
                r.Text = Format(CLng(s) * 1.1, "#,##0")
                r.Collapse wdCollapseEnd
            End If
        Loop
    End With

 End Sub

(マナ) 2021/03/03(水) 17:28


 # すっかり、お見通しのようです。発見するのが少し遅れました。
 テキスト処理ですから、やはり本来はWordが適切なんでしょうね。

 さて、質問者様へ。
 こちらでも、正規表現オブジェクトを一度だけ作成するようにしてみましたが、
 殆ど速度に影響はなかった(余り仕組みが分かっていない。キャッシュ的なものか)ので、
 今のコードをそのまま使ってもらって良いと思います。

 その際、
 ・安全を見て、変換後を上書きするのではなく、他のシートに結果を書き出すように
  したほうがよいかと思います。
 ・ActiveSheetの選択済みセル範囲(複数セル)を対象として、
  以下のようなコードで実行してみて下さい。

 Sub test()
     Dim ws  As Worksheet
     Dim r   As Range
     Set ws = Worksheets("Sheet2")  ' ■要修正

     For Each r In Selection
         If r.Value <> "" Then
             ws.Range(r.Address).Value = myConvert(r.Value)
         End If
     Next
 End Sub

 ■以下は、余談の余談ですので、スキップ頂いて全く問題ありません。

 正規表現周りのツールの話の続きです。
 他の言語、例えば Ruby なんかだと、同様の置換が、下記のように簡単に書けます。

     s = s.gsub(/¥/,"\\").tr('0-9','0-9')
     s = s.gsub(%r{\\([\d,]+)|([\d,]+)(?=円)}) {|m|
         prefix = (m[0] == "\\") ? "\\" : "" 
         num = m.sub(/\\/,"").gsub(/,/,"")
         v = (num.to_i * 1.1).floor
         prefix + v.to_s.reverse.gsub(/(\d{3})(?=\d)/,'\1,').reverse
     }
 ブロックを用いることで、マッチした文字列を m として、
 {  }の中で作成された最後の式の値で、m を置換することができます。
 結構簡単に書けます。    
 (なお、3桁毎のカンマ挿入が少しトリッキーなものになっていますが、
   Railsのツールを使うと、v.to_s(:delimited) と簡単に書けるようです。)

 VBScriptでこんな風に書けるとよいのですが、無理のようです。
 しかし、VBScriptの正規表現をだましだまし使っていかないといけないのですね。

(γ) 2021/03/04(木) 23:26


 同じく正規表現で

 Sub test()
     Dim txt As String
     txt = Join(Array("ハンカチ2枚セットが20%オフで今なら3000円引きの¥2000です!", _
                "5cmの厚みのゲルママットが¥1,000円割引!お得な900円でのご案内"), vbLf)
     MsgBox AddTax(txt, 1.1)
 End Sub

 Function AddTax(ByVal txt As String, Rate As Double) As String
     Dim mtch As Object, m As Object, sm As Object, i As Long, temp As String
     With CreateObject("VBScript.RegExp")
         .Global = True
         .Pattern = "([¥\\])([0-9\d,]+)|([0-9\d,]+)(円)"
         If .test(txt) Then
             Set mtch = .Execute(txt)
             If mtch.Count Then
                 For i = mtch.Count - 1 To 0 Step -1
                     Set m = mtch(i)
                     Set sm = m.submatches
                     temp = sm(0) & Format$(Replace(sm(1) & sm(2), ",", "") * Rate, "#,#") & sm(3)
                     txt = Application.Replace(txt, m.firstindex + 1, m.Length, temp)
                 Next
             End If
         End If
     End With
     AddTax = txt
 End Function
(seiya) 2021/03/05(金) 14:55

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.