[[20150527131720]]　『指定した文字(単位)と数字を抜き出したい』（たけさん）　ページの最後に飛ぶ

『指定した文字(単位)と数字を抜き出したい』（たけさん）

以前の担当の方が辞めてしまい、アクセスで組まれたマクロが動きません。
新たにエクセルVBAで何とかならないかと考えています。

L列に下記の品名があります

ｵﾑﾆﾊﾟｰｸ300ﾁｭｳ 100MLX5V→100MLX5V
ｶﾞｽｺﾝﾄﾞﾛｯﾌﾟﾅｲﾖｳｴｷ2%300ML→300ML
ｸﾞﾘｾﾉﾝﾁｳ 200MLX30ﾌｸﾛ→200MLX30ﾌｸﾛ
KN3ｺﾞｳﾕｴｷ 200MLX20SB→200MLX20SB
ｶﾛﾅｰﾙｼﾞｮｳ 300 100T→100T
ｸﾗﾘｽﾛﾏｲｼﾝDS10%ｼｮｳﾆ B100G→B100G
Aﾍﾞﾝｼﾞﾝ(ﾎﾟﾘ) 500CC →500CC
C.DIFF QUIK CHEKｺﾝﾌﾟﾘ25S→25S
BINAXNOW ﾊｲｴﾝｷｭｳｷﾝ 12ﾃｽﾄ→12ﾃｽﾄ

検索窓に『ML』と単位を入れると
→の右側のように単位を含む数字をVBAで抜出たいのです

ML(ﾐﾘﾘｯﾄﾙ)
T(ﾀﾌﾞﾚｯﾄ)
G(ｸﾞﾗﾑ)
などなど書ききれないほどあります
また数字と単位の間にスペースがあるかというと
必ずしもそういうことではありません

お力をかして頂けると助かります

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 動いている実績があるのであれば、ACCESSのマクロを提示できないでしょうか。
 アプリケーション固有機能でなければ、ほとんどそのまま移植できると思いますが。

（Mook） 2015/05/27(水) 14:04

Mookさん
ありがとうござます
担当の方にお話してみます　お時間下さい!!!
_(_^_)_

（たけさん） 2015/05/27(水) 14:11

 結果和M列に表示

 Sub test()
    Dim r As Range
    With CreateObject("VBScript.RegExp")
        .Pattern = "[A-Z]?(\d+[A-Z\u30A0-\u30F0\uFF76-\uFF9F]+)+$"
        For Each r In Range("L1", Range("L" & Rows.Count).End(xlUp))
            If .test(Trim(r.Value)) Then
                r(, 2).Value = .Execute(Trim$(r.Value))(0)
            End If
        Next
    End With
End Sub
（seiya） 2015/05/27(水) 23:04

seiyaさん

ありがとうございます!!!!!!!
_(_^_)_
思っていた通りの動きで感激です
が、4行目のコードの意味がまったくわからず。。。

また。。。
ﾍﾞｷﾞﾝｸﾘｰﾑ10% 20GX10→20GX10
ｱﾈﾄｶｲﾝｾﾞﾘｰ2% 50MLX3→50MLX3
ﾍﾊﾟﾘﾝNAﾛｯｸ10E/ML 5LX10S→5LX10S

などが抜き出せず、空白になります
お時間ある時に、ご指導ください
（たけさん） 2015/05/28(木) 11:58

         .Pattern = "[A-Z]?(\d+[A-Z\u30A0-\u30F0\uFF76-\uFF9F]+)+$"
                                                              ^
         .Pattern = "[A-Z]?(\d+[A-Z\u30A0-\u30F0\uFF76-\uFF9F]*)+$"
                                                              ^

 に変更してみてください
（seiya） 2015/05/28(木) 12:05

seiyaさん

早々のお返事ありがとうございます

ほぼ抜出できました!!!!!!
感謝、感謝です
おかげさまで、270件あるﾃﾞｰﾀが処理できました

ｱﾛﾝｱﾙﾌｧA 0.5GX5→0.5GX5A(5GX5になってしまう)
ﾊﾞｲｱｸﾞﾗｼﾞｮｳ50MG 10TX2ｼｰﾄ→10TX2ｼｰﾄ
ﾂﾛﾌﾞﾃﾛｰﾙﾃｰﾌﾟ2MG 70ﾏｲ→70ﾏｲ
ﾘﾎﾞﾃｽﾄﾏｲｺﾌﾟﾗｽﾞﾏ 10ｶｲﾖｳ→10ｶｲﾖｳ
ﾛｼｭ PTﾃｽﾄｽﾄﾘｯﾌﾟ 24ﾏｲ→24ﾏｲ
ﾛｰﾙｼ CL5840 5ﾏｷｲﾘ→5ﾏｷｲﾘ
ｼﾞｸﾛﾌｪﾅｸNAｻﾞｻﾞｲ25 CH100ｺ→CH100ｺ(H100ｺになってしまう)

残りはコレです。。。
（たけさん） 2015/05/28(木) 13:23

 .Pattern = "[A-Z]*(\d+(\.\d+)?[A-Z\uFF65-\uFF9F]*)+$
 で良さそうかな?
（seiya） 2015/05/28(木) 13:58

seiyaさん
ありがとうございました!!!!

一部抜けてしまう部分があります
品名の入力が複数人による手入力のため、半角24文字という文字数制限がある(帳票のレイアウトの関係上??)のですが空白に対してなど決まりはなく、個々に入力しているのが現状です
何度もすいません

ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ50ML 5S→50ML(5Sになってしまう)
ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ100ML5S→100ML5S(300ﾁｳｼﾘﾝｼﾞ100ML5Sになってしまう)

前任が急にいなくなり、途方にくれています。。。
ホントにすいません
（たけさん） 2015/05/28(木) 14:29

 .Pattern = "[A-Z]*\d+(\.\d+)?([A-Z]+\d*)*(\d*[\uFF65-\uFF9F]+)?$"
 でもう一度...
 やはり、
 ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ50ML 5S 
 このパターンは他とは矛盾するので　5S が抽出される。
 (seiya)  2015/05/28(木) 15:14
 修正 15:55

seiyaさん
ありがとうございます

ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ50ML 5S
ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ100ML5S

上記はそれぞれ
5S
100ML5S
と表示されます

空白の問題??かなと思い空白を全て置き換えて実行しても変わりませんでした
(-"-)
（たけさん） 2015/05/28(木) 16:10

 >ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ100ML5S→100ML5S(300ﾁｳｼﾘﾝｼﾞ100ML5Sになってしまう) 
 100ML5S が抽出されますよね？

 問題は
 ｵﾑﾆﾊﾟｰｸ300ﾁｳｼﾘﾝｼﾞ50ML 5S
 で最後の5Sの前にスペースがあるので 5S になってしまいます。
（seiya） 2015/05/28(木) 16:20

 苦肉の策でPatternを2段階にすると...

 Sub test2()
    Dim r As Range
    Columns("m").ClearContents
    With CreateObject("VBScript.RegExp")
        For Each r In Range("L1", Range("L" & Rows.Count).End(xlUp))
            .Pattern = "(\d+(\.\d+)?[A-Z]+) \d+(\.\d+)?[A-Z]+$"
            If .test(Trim(r.Value)) Then
                r(, 2).Value = .Execute(Trim$(r.Value))(0).submatches(0)
            Else
                 .Pattern = "[A-Z]*\d+(\.\d+)?([A-Z]+\d*)*(\d*[\uFF65-\uFF9F]+)?$"
                If .test(Trim$(r.Value)) Then r(, 2).Value = .Execute(Trim$(r.Value))(0)
            End If
        Next
    End With
End Su
（seiya） 2015/05/28(木) 16:37

seiyaさん

ありがとうございます

早速、確認してみます(うれし泣き)
_(_^_)_
（たけさん） 2015/05/28(木) 17:11

コメント返信：

[ 一覧(最新更新順) ]

[[20150527131720]] 『指定した文字(単位)と数字を抜き出したい』（たけさん） ページの最後に飛ぶ

[[20150527131720]]　『指定した文字(単位)と数字を抜き出したい』（たけさん）　ページの最後に飛ぶ