D列(D2~)に住所の末尾の方が入っております。
マンション名などを半角に変えてほしいのです。
【壊れ物注意】という文字列のみ削除してください。
2,ファミールマンション310
3,
4,丁目15-6パワーマンション302号山田様方【壊れ物注意】
↓(変換後)
2,ファミールマンション310
3,
4,丁目15-6パワーマンション302号山田様方
★D列に何もないことがあります。(例3行目)
その場合は飛ばして次の4行目を処理してください。D列は色続きになっています。この場合、D2:D4までは色が塗られています。
色がはじめてなくなったとき、つまり白になったときに動作をとめてほしいのです。この場合、D5は色が塗られていませんので、処理はD4までということになります。
よろしくお願いいたします。
マクロでやるなら
Sub Macro() Dim i As Long Dim str As String i = 2 While Cells(i, "D").Interior.ColorIndex = Range("D2").Interior.ColorIndex str = Cells(i, "D").Value str = StrConv(str, vbNarrow) If Len(str) >= 7 Then If Right(str, 7) = "【壊れ物注意】" Then str = Left(str, Len(str) - 7) End If End If Cells(i, "D").Value = str i = i + 1 Wend End Sub
でも、これって数式でもほとんど同じことができるので、例えばE2に次ぎのような数式を入れて
同じ色が続くところまでコピーすればいいです。
それをD列に上書きするには形式を選択して貼付→値のみ。
=ASC(IF(LEN(D2)>=7,IF(RIGHT(D2,7)="【壊れ物注意】",LEFT(D2,LEN(D2)-7),D2),D2))
全角は半角に無条件で変換しています。
Sub 変換() Dim a As Long For a = 2 To Range("D2").End(xlDown).Row If Cells(a, "D").Font.ColorIndex = -4105 Then Exit For Cells(a, "D") = Replace(Cells(a, "D"), "【壊れ物注意】", "") Cells(a, "D") = StrConv(Cells(a, "D"), vbNarrow) Next a End Sub
ありがとうございます!完璧に動きました。短いのもいいですね。
マクロでやるなら
Sub Macro() Dim i As Long Dim str As String i = 2 While Cells(i, "D").Interior.ColorIndex = Range("D2").Interior.ColorIndex str = Cells(i, "D").Value str = StrConv(str, vbNarrow) If Len(str) >= 7 Then If Right(str, 7) = "【壊れ物注意】" Then str = Left(str, Len(str) - 7) End If End If Cells(i, "D").Value = str i = i + 1 Wend End Sub
でも、これって数式でもほとんど同じことができるので、例えばE2に次ぎのような数式を入れて
同じ色が続くところまでコピーすればいいです。
それをD列に上書きするには形式を選択して貼付→値のみ。
=ASC(IF(LEN(D2)>=7,IF(RIGHT(D2,7)="【壊れ物注意】",LEFT(D2,LEN(D2)-7),D2),D2))
いつも感謝しております。詳しいご回答ありがとうございます。式も嬉しいです。これからもどうぞよろしくお願いいたします。
いつも感謝しております。詳しいご回答ありがとうございます。式も嬉しいです。これからもどうぞよろしくお願いいたします。