エクセルの変換機能の置き換えでセル内の不要な文字を削除しているが時間がかかってしまう。

エクセルの変換機能　置き換えでセル内の不要な文字を削除しているが時間がかかってしまう。

ある立列セル内で　後半の不要な文字をとってしまいたい。

そのような場合が50以上あるがかなりマクロでも時間がかかってしまう。早くする方法はないものか。
結果として商品名だけにしたい。

セル内は　「商品名　　何個（数量）」
結果として「商品名」だけにしたい。
（商品名の次　スペースがない場合もある・）

'
Columns("D:D").Select
Selection.Replace What:="1個", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="2個", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="3個", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="4個", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="0.5個", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
・・・・・・

・・・・・・・

・・・・・・

Selection.Replace What:="6ｇ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="7ｇ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


End Sub

いい方法はないものでしょうか　ご教授ください。

No.1 回答者： 銀鱗 回答日時： 2018/11/11 06:25

＞（商品名の次　スペースがない場合もある・）

この条件が無ければ、自分なら「区切り位置」機能を使って商品名と数量を切り分けるんだけどなあ。

・・・
てことで、とりあえず「区切り位置」で「スペース」を区切り文字に指定して、商品名と数量を切り分けてしまいましょう。
でもって商品名の列だけを採用。
例外的にスペースで区切られていないものは手作業で修正。

それで良いと思うんだけど、ダメ？

この回答へのお礼

銀鱗 先生　いつも的確なご回答　感謝申し上げます!。

先生の「自分なら「区切り位置」機能を使って商品名と数量を切り分けるんだけどなあ。

・・・」をご教授くださいまし、空白がないケースは少ないので、従来どおり消していってもそんなに時間はかからないでしょうから。

お礼日時：2018/11/11 06:43

No.2 回答者： tom04 回答日時： 2018/11/11 08:22

こんにちは！

別シートに置換する「検索する文字列」を羅列し、それを利用してはどうでしょうか？
例えば「Sheet2」のA列1行目から　1個　2個　・・・7g　と記入しておくとします。

Sub Sample1()
　Dim i As Long, wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　For i = 1 To wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　Range("D:D").Replace what:=wS.Cells(i, "A"), replacement:="", lookat:=xlPart
　　　Next i
End Sub

程度のコードで大丈夫です。m(_ _)m

No.3 回答者： WindFaller 回答日時： 2018/11/11 08:53

こんにちは。

私には、マクロの内容は分かったけれども、具体例がないので、はっきりしていません。
>「商品名 何個（数量）」結果として「商品名」
例：

もも10個
みかん20個
バナナ 11本
ぶどう5房

というようになっているなら、マクロでしなくてもよいとは思いますが、マクロでやるなら、
スピードの保証はしかねますが、このようなものが考えられます。

Sub RemoveNumbers()
　Dim RegEx As Object
　Dim c As Range
　Set RegEx = CreateObject("VBScript.RegExp")
　With RegEx
　　.Global = False: .IgnoreCase = False
　　.Pattern = "\s*\d+.*"　　'*
　End With
　Application.ScreenUpdating = False
　For Each c In Range("D1", Cells(Rows.Count, "D").End(xlUp))
　　If c.Value Like "*#*" Then
　　　c.Value = RegEx.Replace(c.Value, "")
　　End If
　Next
　Application.ScreenUpdating = True
End Sub

*　パターンの全角数字は考慮されていません。必要なら、一旦半角にするか、パターンに、全角数字を対象を含めなければなりません。
"\s*\d+.*"
この意味は、\s スペース等、\d は半角数字、* は、0個以上、+は、一個以上
．（点）は、ワイルドカードのすべての文字

No.4 回答者： googoo900 回答日時： 2018/11/12 15:30

マクロで行うよりも、エクセルの置換機能のほうが早いです。

>セル内は　「商品名　　何個（数量）」
>結果として「商品名」だけにしたい。
>（商品名の次　スペースがない場合もある・）
>空白がないケースは少ないので、従来どおり消していってもそんなに時間はかからないでしょうから。

という条件であれば、空白があるケースを置換機能で削除していきます。
◆手順
１．対象範囲を選択
２．CTRL＋"H"（置換のショートカットキー）
３．検索する文字列　　『 *』　←　空白とアスタリスク
４．置換後の文字列　　『』　　←　何も入力しない
５．『すべて置換』をクリック


空白がないケースは従来通りの手法で対応ください。
とはいえ、一定の法則性があれば消せます。
例えば、1個、2個、など『1桁の数値＋"個"』の場合。
◆手順
１．対象範囲を選択
２．CTRL＋"H"（置換のショートカットキー）
３．検索する文字列　　『?個』　←　半角クエスチョンマークと個
４．置換後の文字列　　『』　　←　何も入力しない
５．『すべて置換』をクリック

6g、7gという場合も手順３の"個"を"g"にかえれば対応できます。

No.5 回答者： WindFaller 回答日時： 2018/11/14 17:53

No.3の回答者です。

私のマクロの前提となっている条件を書き入れておきます。
それから、修正をしておきます。理由は、製品名の型番が入っている可能性があるからです。

>セル内は 「商品名 何個（数量）」
>結果として「商品名」だけにしたい。

あくまでも、セルひとつの中に、「商品名 何個（数量）」とある場合で、
マクロをみると、「xlPart」になっているということからです。（マクロのベースとなっている商品リストのサンプル画像）

この場合、区切り位置を使えれば使ってもよいと思うのですが、元のレイアウトに戻すには、いくつか手間が増えます。

Sub RemoveNumbers1()
Dim RegEx As Object
Dim c As Range
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
　.Global = False: .IgnoreCase = False
　.Pattern = "\s*[\d\.]+\s?(個|[kg]+|セット|台)$"
End With
Application.ScreenUpdating = False
For Each c In Range("D1", Cells(Rows.Count, "D").End(xlUp))
　If c.Value Like "*#*" Then
　 c.Value = RegEx.Replace(Trim(c.Value), "")
　End If
Next
Application.ScreenUpdating = True
End Sub

//

パターンは、その状況によっていろいろ変わります。
正規表現というのですが、なかなかややこしいです。

kg と g と兼用
"\s*[\d\.]+(個|[kg]+|セット|台)$"
前回に続いて、
(個|[kg]+|セット|台)
それぞれの区切りのひとつに該当する。
$は、末尾。

早い遅いは別として、1回で済むようにマクロを考えました。
これは、正規表現が可能なエディタでも良いと思います。