オンライン健康相談、gooドクター

こんにちは。Excel VBAの作成方法をご教示ください。
添付ファイルをご参照下さい。現行の品番の体系を変更するマクロを組みたいのですが、どのようにすればよいかをご教示ください。

A列には、以下2ケースの品番が混在しております。マクロボタン押下することで、下矢印の処理が回り、ケース1,2ともに同時に品番体系の変更ができないでしょうか。(具体的な変更例は添付ファイルをご参照ください)

ケース1.XXXXX-XXX -XXXX-XX →ハイフンとスペースを除去し統合
ケース2.XXXXX-XXX -XXXX-XX-0X →①ハイフンとスペースを除去
                   ②末尾2桁目の0を除外
                   ③統合

お知恵お貸し頂きたく、お願いいたします。

「Excel VBAの作成方法をご教示くだ」の質問画像
gooドクター

A 回答 (2件)

こんにちは、


すでに回答がありますが、
>Excel VBAの作成方法をご教示ください。
なので、べたに表示の文字列の文字数に着目した方法を書きました。
Sub sample()
 Dim c As Range
 'アクティブシートのA列をループ
 For Each c In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
   '文字数が21文字以上なら
   If Len(c.Text) >= 21 Then
   '下3文字から2文字が "-0"なら(枝番が3桁の場合を想定)
     If Left(Right(c.Text, 3), 2) = "-0" Then
'右2文字までの左側文字と最後の文字をつなげる(右から2文字目を排除)
       c.Value = Left(c.Text, Len(c.Text) - 2) & Right(c.Text, 1)
     End If
   '文字に含まれる半角スペース半角-を削除
     c.Value = Replace(Replace(c.Text, " ", ""), "-", "")
   '文字数が18文字以上20文字以内なら
   ElseIf Len(c.Text) >= 18 And Len(c.Text) <= 20 Then
   '文字に含まれる半角スペース半角-を削除
     c.Value = Replace(Replace(c.Text, " ", ""), "-", "")
   End If
 Next c
End Sub
注意:
同じ場所に書き込みされるので、コピーシートなどで検証してください。
    • good
    • 1
この回答へのお礼

ご丁寧にありがとうございました!できました。

お礼日時:2021/04/15 15:33

こんにちは



例示のケースの内容と、添付の図では桁数が異なっているように見えますけれど・・・

>Excel VBAの作成方法をご教示ください。
あまりにも漠としているので、なんとも言えませんが、VBAエディタにご提示の順で処理を記入すればよいでしょう。

細かな点で不明はありますが、ひとまずのサンプルとして…
※ 隣のB列に結果を入力すようにしてあります。

Sub sample_12310268()
Dim c, i, s

For Each c In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
s = Split(c.Text, "-")
For i = LBound(s) To UBound(s)
s(i) = Trim(s(i))
If i = 4 Then If Left(s(4), 1) = "0" Then s(4) = Mid(s(4), 2, Len(s(4)))
Next i
c.Offset(, 1).NumberFormatLocal = "@"
c.Offset(, 1).Value = Join(s, "")
Next c

End Sub
    • good
    • 1
この回答へのお礼

ご丁寧にありがとうございました。助かりました

お礼日時:2021/04/15 15:33

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング