文字列中の半角カタカナ文字だけを半角スペースに置換

質問

文字列中の半角カタカナ文字だけを半角スペースに置換し、
「それ以外の文字列」だけをそのまま残して整形したいのです。
EXCELのVBAで処理できますか　？
(Sheet1に文字列がある状態でSheet2に完成形を作成する)

「それ以外の文字列」とは、半角の英語（A,a,B,b）や半角数字で
全角や日本語漢字などはありません。

カタカナ文字の数が多いのでどのようにカタカナ文字の候補を
定義すれば上手く処理できるかイメージ出来ません。

以下に実際に近い例文及び完成形（整形後）のイメージです。
完成形は、イメージなので間違っているところがあると思われます。

整形前　Sheet1 -----------------------------------------------------------------

ﾜﾛｲｲｱｱｰ ｰ ｰ ｰｱｱｲｲﾛﾜ
ﾛｲﾟ ﾟﾟ ﾜﾜｲｲｲｲﾜﾜ ｱｰ p r e s e n t s ｰｱ ﾜﾜｲｲｲｲﾜﾜ ﾟﾟ ﾟｲﾛ
ﾟﾜ ﾜﾛﾟﾟﾟ ﾟﾟﾛｲｱｰﾟ ﾟｰｱｲﾛﾟﾟ ﾟﾟﾟﾛﾜ ﾜﾟ
 ﾟ ﾟﾟ ﾟﾟ ﾟ 

[ Turget 1 ]
[ URL : http://www.gdbps.com.jp ]
[ Doom : Windows ]

ﾜﾛｲｱｰ   ｰｱｲﾛﾜ
ﾜﾛｲｲｱｱｰ ｰ : T A R G E T : ｰ ｰｱｱｲｲﾛﾜ
ﾛｲﾟ ﾟﾟ ﾜﾜｲｲｲｲﾜﾜ ｱｰ ｰｱ ﾜﾜｲｲｲｲﾜﾜ ﾟﾟ ﾟｲﾛ
ﾟﾜ ﾜﾛﾟﾟﾟ ﾟﾟﾛｲｱｰﾟ : LINE OF SETING : ﾟｰｱｲﾛﾟﾟ ﾟﾟﾟﾛﾜ ﾜﾟ
 ﾟ ﾟﾟ ﾟﾟ ﾟ 
ﾜﾜ ﾟﾜ ﾜﾟ ﾜﾜ
ﾜﾛｲｲｲｲﾛﾛﾜ ﾜｱｰ ｰｱﾜ ﾜﾛﾛｲｲｲｲﾛﾜ

整形後　sheet2 --------------------------------------------------------------

p r e s e n t s

[ Turget 1 ]
[ URL : http://www.gdbps.com.jp ]
[ Doom : Windows ]

: T A R G E T :

: LINE OF SETING :
------------------------------------------------------------------

回答No.6

kkkkkm · ベストアンサー

> 上記の方法で調べたら「20」とでました。

20は半角スペースですので先頭に半角スペースが含まれてコピペされてると思います。
式を以下に変更(TRIMは前後のスペースを削除します)してみてください。

=DEC2HEX(UNICODE(TRIM(どこかのセル)))

また、「 .Pattern =」で指定する文字コードの前には「\」だけではなく「u」が必要です。
\u文字コード
です。

なお、その文字がどの文字カテゴリなのかお知りになりたい場合は、IMEパッドを開いて文字一覧からそのコードを探してみてください。
上記の式でコードが出たらUnicodeの中にあると思います。
たとえば半角カタカナの「ｱ」のコード「FF71」を探す場合「U+FF70」の行の「1」の列になります。
探した文字コードを一番上の行で表示したときに左のツリーで選択されたものがカテゴリーになります。

お礼

kkkkkmさん、何度もありがとうございます。

>先頭に半角スペースが含まれてコピペされてると思います。

おっしゃるように半角スペースが最初に入っていました。
訂正してチェックすると問題の文字コードは、
　kkkkkmさんが書き込みした「F8F2」でした。

　\uF8F2　を追加して完成しました。

コードを追加する方法も理解できたので以後何とかなりそうです。

改めてお礼申し上げます。

回答No.5

kkkkkm

変換したA列のデータは元の文字数分半角スペースがあります

Ws2.Cells(i, "A") = " "

だと半角スペース1個だけ対応になりますので、半角スぺースの文字数分を比較するようにします。
また、行を削除する場合は、最後の行から削除しないと抜けが出ます。
たとえば、3行目の指示で3行目を削除した途端に元の4行目が3行目に、5行目が4行目になります。なので、次の4行目への指示は元の5行目への指示となり元の4行目がスルーされます。

以下は対象A列のセルにデータが無い場合は削除しないパターンです。

Dim i As Long, FRow As Long
FRow = 1
Application.ScreenUpdating = False

For i = 400 To FRow Step -1
If Ws2.Cells(i, "A") <> "" Then
If Ws2.Cells(i, "A") = String(Len(Ws2.Cells(i, "A")), " ") Then Ws2.Rows(i).Delete
End If
Next i

Application.ScreenUpdating = True

お礼

追加のアドバイスありがとうございます。

>四角に×になっている文字コードがわかれば

OKWAVEに投稿する前は、見かけは四角でXのコードでは無いのですが
　　OKWAVEに投稿するとそのような見え方になりました。

>=DEC2HEX(UNICODE(どこかのセル))としたらわかります

上記の方法で調べたら「20」とでました。
　　以下のように変更してみましたが、「20」相当の文字コードの部分は
　　　　半角スペースに置換されなかったです。
　　　　　　（どこか間違ってますか　？）
　　 .Pattern = "[\20\uFF61-\uFF9F]+"

----------------------------------------------
>対象A列のセルにデータが無い場合は削除しないパターンです。

　　「行を削除する場合は、最後の行から削除しないと抜けが出ます。」
　　　言われてみると先頭から削除する方法は的外れでした。
　　　（説明されると、「なるほど」と納得しました。）

　　データが無い場合は削除しないは、発想に全く無かったのです。

　　早速、コードを変更して改行のない整形分が出来ました。
　　　（後は、見やすいように適当に改行を手動で入れる方法で十分です。）

回答No.4

kkkkkm

No1の一部訂正です。

連続した文字列を空白一個に変換してました。
myStr = Replace(myStr, Match.Value, " ", , 1)
を
myStr = Replace(myStr, Match.Value, String(Len(Match.Value), " "), , 1)
に変更してください。

また、四角に×になっている文字コードがわかれば
(その文字だけどこかのセルにコピーして
=DEC2HEX(UNICODE(どこかのセル))
としたらわかります)

.Pattern = "[\uFF61-\uFF9F]+"
のところを
コードがF8F2でしたら
.Pattern = "[\uF8F2\uFF61-\uFF9F]+"
にして試してみてください。

回答No.3

imogasi

Excel関数では無理でしょう。
（特別のソフトを使わなければ）１文字単位の繰り返しの考えを採らないといけないので。
ーー
正規表現の回答は出ています。
ーーー
Lile演算子を使う、による回答を上げる。
標準モジュールに
Sub Sample1()
Dim s As String

lr = Range("A10000").End(xlUp).Row
For i = 1 To lr
s = ""
x = Cells(i, "A")
For j = 1 To Len(x)
If Mid(x, j, 1) Like "[ア-ン]" Then
s = s & " "
Else
s = s & Mid(x, j, 1)
End If
Next j
Cells(i, "B") = s
Next i

End Sub
例データ
　A列各セルに、データがあるとする。
B列が結果がでます。
ーー
WEBに、記事がたくさんある事項ですよ。
もっとWEB照会を使え。検索語は
like演算子 カタカナ
vba カタカナ 判定
など。

回答No.2

kzr260v2

今回のご要望を満たす仕組みとして、以前から正規表現というものがあります。特殊な文字検索が可能で、文字コードの並び範囲を指定することができます。例えば、半角カナでしたら、[ｦ-ﾟ] という表現になります。以下の文字コード表を参照ください。「並び」と説明した意味が分かると思います。

しかし、Excelは正規表現に対応してないようですので、Windowsの標準機能ならPowerShellを使うか、正規表現に対応したテキストエディタなどのソフトを使うか、Excelに他者が作成した正規表現対応モジュールを追加する、このような方法になります。

PowerShellは、スクリプトといういわばプログラミングをする、というイメージになります。PowerShell自体を扱うことの慣れが必要になります。
まずは、以下のようなキーワードで、Googleなどを検索して、
PowerShell 初心者
次に、
PowerShell テキスト 文字列 置き換え 正規表現
このような検索をすることが考えられます。

テキストエディタを探すのは比較的簡単です。
テキストエディタ 正規表現
テキストエディタ 正規表現 フリーソフト
このような感じです。使い方も、それほど難しくないと思います。

Excelに正規表現機能を追加する方向なら、
Excel 正規表現
このようなキーワードが考えられます。
私の個人的な考えとしては、Excelに他者が作成した機能をすることには、迷いがあります。Excelは巨大なソフトウェアですし、仕事で使用する重要なソフトウェアです。不安定になるのは大変困りますので、テスト用の別のパソコンが使えるなら、そちらでのみ試したい、そんな方向の方法です。

以上、参考にならなかったらごめんなさい。

回答No.1

kkkkkm

質問文で一部文字が四角に×になっているもの(外字？)が何か不明なので変換されませんがそれ以外は以下のコードで変換できると思います。

Sub Test()
Dim c As Range
Dim myStr As String
Dim Match As Object, Matches As Object
Dim Ws1 As Worksheet, Ws2 As Worksheet

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")

With CreateObject("VBScript.RegExp")
.Pattern = "[\uFF61-\uFF9F]+"
.Global = True

For Each c In Ws1.Range("A1:A20") '実際の範囲を指定してください。
myStr = c.Value
If Len(myStr) > 0 Then
Set Matches = .Execute(myStr)
For Each Match In Matches
myStr = Replace(myStr, Match.Value, " ", , 1)
Next Match
Ws2.Cells(c.Row, c.Column).Value = myStr
End If
Next c
End With
End Sub

参考
https://www.moug.net/tech/exvba/0140015.html

お礼

kkkkkmさん、コードの提示ありがとうございます。

お陰様でやりたいことはできました。
実際の整形シートを見直すと行に何も表示されない行が多数あって
　これを削除するためにコードを追加したのですが
　　上手く機能しません。
　どこが間違っているのでしょうか　？

Sub Test_1()
Dim c As Range
Dim myStr As String
Dim Match As Object, Matches As Object
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet

Set Ws1 = Sheets("Target")
Set Ws2 = Sheets("整形")

With CreateObject("VBScript.RegExp")
.Pattern = "[\uFF61-\uFF9F]+" '正規表現で半角カナの文字リスト
.Global = True

'サーチ範囲は任意で（A400）
For Each c In Ws1.Range("A1:A400")
myStr = c.Value
If Len(myStr) > 0 Then
Set Matches = .Execute(myStr)

'半角カナを空白に置換
For Each Match In Matches
myStr = Replace(myStr, Match.Value, " ", , 1)
Next Match
Ws2.Cells(c.Row, c.Column).Value = myStr
End If
Next c
End With

　’空白のセルは行を削除
Dim i As Long
i = 1
Application.ScreenUpdating = False

For i = i To 400
If Ws2.Cells(i, "A") = " " Then Ws2.Rows(i).Delete
Next i

Application.ScreenUpdating = True
End Sub