(VBA)文字列の最後のスペース及びーを削除

質問

(VBA)文字列の最後のスペース及びーを削除

2021/09/01 11:35
offie_2019,windows10

ちょっと紛らわしい質問なのですが
例えば、E列に文字列が数十行あって
　それぞれの文字列の最後が下記のよう場合
　不必要なスペースと-を削除したいのですが何か方法がありますか　？

（視認性を良くするために
　　半角又は全角のスペースを□で表します。）

-は、半角若しくは全角

それぞれ削除した文字列をE列の横のF列に書き出す形式を考えています。

takano□-
takano-
takano□-
takano□-□
takano.
takano.□
takano□(vol.2)□-

不必要削除後は、

takano
takano
takano
takano
takano.
takano.
takano
takano□(vol.2)

一例の参考画像を下記に添付しました

回答No.5

kkkkkm · ベストアンサー

考え方はその通りです。

>A)「-」は、U＋002D　＝　ハイフン マイナス
> B)「－」は、U＋FF0D　＝　全角ハイフン マイナス

両方ともそのコードです。

> ----　「、」が半角になったら嫌な場合は　------
> の意味が良くわからないのですが　？

StrConv(Cells(i, "E").Value, vbNarrow)
で全て半角にしていますので
「、」0x3001
が
「､」0xFF64
になってしまいます。

また、
ta-kano□－□

のように途中に「-」がある場合は、どろくさくて申し訳ありませんが以下のようにしてください。
毎回セルを操作すると時間がかかりそうだったので一気に配列変数にいれて操作してます。

Sub Test4()
Dim tmp As Variant
Dim i As Long, j As Long

tmp = Range(Cells(1, "E"), Cells(Rows.Count, "E").End(xlUp)).Value
For i = 1 To UBound(tmp)
For j = Len(tmp(i, 1)) To 1 Step -1
If Mid(tmp(i, 1), j, 1) <> "-" And _
Mid(tmp(i, 1), j, 1) <> "－" And _
Mid(tmp(i, 1), j, 1) <> " " And _
Mid(tmp(i, 1), j, 1) <> "　" Then
tmp(i, 1) = Left(tmp(i, 1), j)
Exit For
End If
Next
Next
Cells(1, "F").Resize(UBound(tmp), 1).Value = tmp
End Sub

補足

追加の回答感謝します。

No.5の回答をより
まったく気が付かなかったのですが　
Test3はTest1（又はTset2）の後に続けて利用する事を想定されているのですね。？

下記は、Test2+Test3の結果です。
https://imgur.com/0m2Ja2E

同じくTest4は、Test1（又はTset2）の後に続けて利用する事を想定されているのですね。？
（Test4はTest3の修正版）

上記の理解が正しいとして
実際の処理文字列でチェックしてみますので
　少し時間をください。

（間違っている場合は、ダメだしをお願いします。）
---------------------------------------------
>で全て半角にしていますので
「、」0x3001　/　U＋3001 = 表意文字コンマ
が
「､」0xFF64　/　U＋FF64　＝　半角表意コンマ
になってしまいます。

正直この違いが良く分かっていません。

回答No.16

imogasi

回答をコピペして終わらせようという意図が見える。
もっと、すべきことを、どう表現したらよいのか、「文章で」表現できるように、自分で案文を作り
質問に上げて、その表現で十分（すべての場合を尽くしているか、出来れば余分なものはないかも）
、読者に批判を仰ぐやり方を、まずすべきと思う（ここで９割り方出来が決まる）。
友達（素人）でも、読んでもらえば、ここまで（ケースの漏れを見つける）は出来るはず（漏れたケースなどを見つけてくれるだろう）。
　対処できる方法論・道具（コード）は、IF、LEN、Mid、Instr、（ｌ・R）Trimなどしかないのだから
（あと＆で文字列の継ぎはぎ）上記文章（多分箇条書き）をそれらでコードに落とすほかないのでは。
＝＝
その他に、VBSの正規表現（RegExp）を使う方法があると思うが、小生は経験から、難しいと思うので勧めないが、熟達者向きにはあるよ。

お礼

imogasiさんの辛口のお叱り次回に生かしたいと思います。

回答No.15

kkkkkm

あれ、尻切れトンボになってましたm(__)m

Next
Next
のあとに

Cells(1, "F").Resize(UBound(tmp), 1).Value = tmp
Set RegExp = Nothing
End Sub

回答No.14

kkkkkm

最後の
Set RegExp = Nothing
を忘れてました。

回答No.13

kkkkkm

お目汚しで見てみてください。

条件をAndAndで繋いでいくのも面倒なので正規表現で
RegExp.Pattern = "[-－ー\s\s　]"
[]の中に削除したい文字を羅列します。
スペースは\sで全角スペースは\sのあとに実際の全角スペース

Sub Test4_1()
Dim tmp As Variant
Dim i As Long, j As Long
Dim RegExp As Object

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Pattern = "[-－ー\s\s　]"

tmp = Range(Cells(1, "E"), Cells(Rows.Count, "E").End(xlUp)).Value

For i = 1 To UBound(tmp)
For j = Len(tmp(i, 1)) To 1 Step -1
If RegExp.Test(Mid(tmp(i, 1), j, 1)) = False Then
tmp(i, 1) = Left(tmp(i, 1), j)
Exit For
End If
Next
Next

お礼

kkkkkmさん、Test4の正規版（Test4_1)をありがとうございます。

正規表現は、過去何度か教えてもらっていますが
　見た目はすっきりなのに非常に強力ですが
　個人的にはTest4のコードは煩雑ですが理解はしやすいです。

　正規版(Test4_1)で実際のDATAでチェックして
　　思っていたいた結果が出力されました。
（Test4と機能は同じなので当然ですが。。。）

今回も最後までお付き合い願い有難うございました。

回答No.12

HohoPapa

>できればSub（）形式のコードで教えていただけないでしょうか　？
以下でいかがでしょうか。

Option Explicit

Sub sample()

　Dim RowCnt As Long
　RowCnt = 1　　'データの開始する行番号

　With ThisWorkbook.Sheets("Sheet1")　'データの埋まったシート
　　Do
　　　If .Cells(RowCnt, 5).Value = "" Then Exit Do '5:Ｅ列、6:Ｆ列
　　　.Cells(RowCnt, 6).Value = _
　　　　　orgDel(.Cells(RowCnt, 5).Value)
　　　RowCnt = RowCnt + 1　　　　'
　　Loop
　End With

End Sub

Function orgDel(MyText As String) As String

　Do
　　If ( _
　　　(Right(MyText, 1) = " ") Or _
　　　(Right(MyText, 1) = "　") Or _
　　　(Right(MyText, 1) = "-") Or _
　　　(Right(MyText, 1) = "－") Or _
　　　(Right(MyText, 1) = "ー")) Then
　　　MyText = Left(MyText, Len(MyText) - 1)
　　Else
　　　Exit Do
　　End If

　Loop

　orgDel = MyText

End Function

お礼

HohoPapaさん、大変わかりやすいコメント付きのコードをありがとうございます。

実際のDATAでチェックして思い道理の結果が表示されました。
これで列、行が変更されてもマクロで対応できるようになりました。

お礼申し上げます。

回答No.11

kkkkkm

> > '途中に「-(U+002D)及び－(U+FF0D)及びー(U+30FC)」がある場合
> > '途中に「 (U+0020)及び　(U+3000)がある場合
>
> 途中ではなく

読み違えてましたm(__)m
その時のコードという意味ですね。

(A)途中に「-(U+002D)及び－(U+FF0D)及びー(U+30FC)」がある場合

その可能性がある場合です。なくても大丈夫です。

Test3では、途中の「 (U+0020)及び　(U+3000)はReplaceせずに最後だけ取り除くので(A)でなければTest3で大丈夫です。
Test4だと(A)であってもなくてもいいので可能性が0でないのでしたらTest4でいいと思います。

回答No.10

kkkkkm

> '途中に「-(U+002D)及び－(U+FF0D)及びー(U+30FC)」がある場合
> '途中に「 (U+0020)及び　(U+3000)がある場合

途中ではなく

文字列の末尾から検索して(文字数から1までjを減算してループ)
For j = Len(tmp(i, 1)) To 1 Step -1

If複数条件が<>のAndなので
該当する文字が現れなくなったらそこで

文字列の左から現れなくなったところまでのj文字分を
tmp(i, 1)に入れ直す。

tmp(i, 1) = Left(tmp(i, 1), j)

という流れです。

tmp(i, 1)は
取り込んだセル範囲の左上をtmp(1,1)として
tmp(行,列)です。

あと、すみませんtmpなどという間違いそうな変数を使ってて。
MId(temp(i,1),j,1) <> "ー" And _
は
MId(tmp(i,1),j,1) <> "ー" And _
です。

補足

No5に下記のような記載があったので
　配列変数は、初心者には難しいので間違った認識をしてしまいました。

>のように途中に「-」がある場合は、どろくさくて申し訳ありませんが以下のようにしてください。

test4のコメントを下記のように変更しました
’文字列の末尾から「-(U+002D)及び－(U+FF0D)及びー(U+30FC)」及び「 (U+0020)及び　(U+3000)を検索して
'該当する文字が現れなくなったらそこで処理終了

末尾から検索する方が考え方は
　HohoPapaさんも採用した手段と同じで理解しやすいです。

回答No.9

kkkkkm

No8の補足です。
Test3以降は半角にはなりません。

回答No.8

kkkkkm

「、」の件は
全角「、」0x3001が半角カナの「､」0xFF64なるということです。
「コアラのマーチ」のカタカナは半角カタカナになります。

回答No.7

kkkkkm

> 下記は、Test2+Test3の結果です。
> https://imgur.com/0m2Ja2E

Test2+Test3の結果だと
ta-kano－
は
takano
になると思います。
画像はTest4の結果じゃないでしょうか。

Test1,Test2,Test3,Test4それぞれ単独で結果を出します。

補足

>画像はTest4の結果じゃないでしょうか。
>Test1,Test2,Test3,Test4それぞれ単独で結果を出します。

すいませんミスの指摘感謝します。
（画像の添付ミスもあり、・・・・）

まだ途中ですが、
　test4に一部コードを追加して以下で本テスト中です。
　　（コメント有ればお願いします。）

Sub Test4()
'途中に「-(U+002D)及び－(U+FF0D)及びー(U+30FC)」がある場合
'途中に「 (U+0020)及び　(U+3000)がある場合

Dim tmp As Variant
Dim i As Long, j As Long

tmp = Range(Cells(1, "E"), Cells(Rows.Count, "E").End(xlUp)).Value
For i = 1 To UBound(tmp)
For j = Len(tmp(i, 1)) To 1 Step -1
If Mid(tmp(i, 1), j, 1) <> "-" And _ ’U+002D
Mid(tmp(i, 1), j, 1) <> "－" And _ ’U+FF0D
MId(temp(i,1),j,1) <> "ー" And _ 'U+30FC
Mid(tmp(i, 1), j, 1) <> " " And _ ’U+0020
Mid(tmp(i, 1), j, 1) <> "　" Then ’U+3000
tmp(i, 1) = Left(tmp(i, 1), j)
Exit For
End If
Next
Next
Cells(1, "F").Resize(UBound(tmp), 1).Value = tmp
End Sub