[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『文字列から』（ＢＬＣ眼鏡）
電話販売のコールセンター業務をしております。
お客様に商品をご案内する際のテキストがエクセル管理されているのですが、文字列と数字が規則性なく並んでいる単なる文章です。
このような内容を、金額の部分だけ税込表示（つまり1.1倍）したいです。
金額には、前に「￥」「\」又は後ろに「円」が必ずついていることがわかったので、[,]は削除し、全角数字/文字列は全て半角に変換すれば
”前に[\]又は後ろに[円]が付いた数字を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-9０-９,，]{1,}円"
.Replacement.Font.Color = vbRed
.Execute Replace:=wdReplaceAll, Format:=True
.Text = "[\\￥][0-9０-９,，]{1,}"
.Execute Replace:=wdReplaceAll, Format:=True
.Font.Color = vbRed
.Text = "[0-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円割引！お得な９００円でのご案内 (変換後) ハンカチ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円割引！お得な９００円でのご案内"
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 = "\\([\d０-９,]+)"
cond2 = "([\d０-９,]+)(?=円)"
.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
γさんのを真似て,少しだけ修正 １）\を半角に置換 ２）数値の書式はカンマ付き ３）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-9０-９,，]{1,}円"
.Replacement.Font.Color = vbRed
.Execute Replace:=wdReplaceAll, Format:=True
.Text = "[\\￥]([0-9０-９,，]{1,})"
.Replacement.Text = "^92\1"
.Execute Replace:=wdReplaceAll, Format:=True
.Font.Color = vbRed
.Text = "[0-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')
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円割引！お得な９００円でのご案内"), 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 = "([￥\\])([０-９\d,]+)|([０-９\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.