テキストファイル中のカタカナ文字をスペースに変換

質問

エクセル（VBA)で
テキストファイル(.txt)中の半角カタカナ文字を半角スペース文字に置き換えたいのですが
ネットで検索しても同じ項目が探しきれませんでした。

どのようなコードが考えられますか　？

Office 2019

回答No.5

HohoPapa · ベストアンサー

>ただ、以下の左上に丸が変換できれば完璧です。
>（必要ない丸が残りました。）
ありゃ、ごめんなさい。

半角カタカナに使っている濁点、半濁点を考慮していなかったので
直して再ポストします。
また、カタカナの範囲は、添付画像の範囲です。
また、コードを10進で記載したためわかりにくいので
16進表記にしました。

Sub Sample1()

　Dim buf As String
　Dim Target

　Target = _
　　Application.GetOpenFilename(Filefilter:="ansiのテキストファイル,*.txt")
　If Target = False Then Exit Sub

　With CreateObject("ADODB.Stream")
　　.Charset = "Shift_jis"
　　.Open
　　.LoadFromFile Target
　　buf = .ReadText
　　.Close
　　.Open
　　.writetext ChgKana(buf)
　　.savetofile Target, 2
　　.Close
　End With

End Sub

Function ChgKana(text As String) As String

　Dim MyLen As Long
　Dim wkStr As String
　Dim i As Long
　MyLen = Len(text)

　wkStr = ""
　For i = 1 To MyLen
'　　If ( _
'　　　 (Asc(Mid(text, i, 1)) >= 166) And _
'　　　 (Asc(Mid(text, i, 1)) <= 223)) Then
'　　　wkStr = wkStr & " "
'　　Else
'　　　wkStr = wkStr & Mid(text, i, 1)
'　　End If

　　If ( _
　　　 (Asc(Mid(text, i, 1)) >= &HA6) And _
　　　 (Asc(Mid(text, i, 1)) <= &HDF)) Then
　　　wkStr = wkStr & " "
　　Else
　　　wkStr = wkStr & Mid(text, i, 1)
　　End If

　Next i
　ChgKana = wkStr

End Function

>宜しければ、No.3のお礼で提示した
>　無駄な改行を削除するための処理を教えて下さい。
のちほど挑戦します。

お礼

HohoPapaさん、回答感謝します。

提示いただいた濁点、半濁点を考慮したコードは、
　用意した3つのテキストファイルで完璧に作動しました。
　（まだチェックしたテキストファイルが少ないので
　　もうしばらく試用を続けたいと思います。）
--------------------------------------------------
無駄な改行の削除コードの修正ありがとうございます。

無駄な改行を削除するコードですが、
　HohoPapaさんSamplex()と私の試したsample1()を比較しました。

まず、私のコードは
　Dim SelectyFile As Variant
は、
　Dim SelectFile As Variant
の誤りであることが判明しました。
（不要な「ｙ」がなぜだか？付加されていました。）

又、私のコードでは以下のDimの宣言がなされていませんでした。
　　Dim buf As String
Dim n As Long
Dim x As String
Dim y As String

これは、作動のは無関係だと思いますが
　.ROW　（HohoPapa）
　.row　（NuboChan)
とRが大文字、小文字の違いがありました。

これも作動には直接無関係だと思いますが
　ThisWorkbook.Sheets("Sheet2")　　（HohoPapa）
　Sheets("Sheet2")　　　　　　　　（NuboChan)
ThisWorkbookの指定が有無の違いがありました。

------------------------------------
Samplex()を試しましたが、
　　うまく処理できませんでした。

期待と異なる場合は、新規スレッドで質問くださいと有ったので
　以降は、新規スレッドに移行します。

回答No.6

HohoPapa

提示のコードを動作するようにしてみました。
これが期待の動作なのかどうか、当方では判断できません。
もし期待と異なるのであれば、
スレッドを改め、
変換元のテキストと
期待する返還後のシートの内容を示してください。

Sub Samplex()
Dim i As Single
Dim j As Single
Dim SelectFile As Variant
Dim LastRow As Single

Dim s '// セル値
Dim iRow '// 行位置
Dim iCol '// 列位置
Dim iMaxRow '// シートでの最終行
Dim buf As String
Dim n As Long
Dim x As String
Dim y As String

' ChDir "C:\Users\NuNu\Desktop"
SelectFile = Application.GetOpenFilename("txtファイル(*.txt),*.txt")

If VarType(SelectFile) = vbBoolean Then
MsgBox "キャンセルされました"
Exit Sub
Else
'MsgBox SelectFile & " が選択されました"
Open SelectFile For Input As #1
End If

Do Until EOF(1)
Line Input #1, buf
n = n + 1
Cells(n, 1) = buf
Loop
Close #1

LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To LastRow
x = Sheet1.Cells(i, "A")
'MsgBox x
For j = 1 To Len(x)
y = Mid(x, j, 1)
' MsgBox y
If y Like "[ｦ-ﾟ ]" Then
'MsgBox "半角カナ"
s = s & " "
Else
s = s & y
End If
Next j
ThisWorkbook.Sheets("Sheet2").Cells(i, "A") = s
s = ""
Next i

'Stop

'Application.ScreenUpdating = False

ThisWorkbook.Sheets("Sheet2").Activate

iRow = ActiveCell.Row
iCol = ActiveCell.Column
iMaxRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1

'// アクティブ列の行をループ
Do
If (ActiveCell.Row > iMaxRow) Then
Exit Do
End If

s = ActiveCell.Value

'// セル値が未設定の場合
If (s = "") Then
'// 空行削除
ActiveCell.EntireRow.Delete

'// 削除により最終行が上に移動するため値を調整
iMaxRow = iMaxRow - 1
Else
'// 次行に選択セルを変更する
ActiveCell.Offset(1, 0).Select
End If
Loop

'// 初期選択位置を選択
Cells(iRow, iCol).Select

'Application.ScreenUpdating = True

End Sub

回答No.4

HohoPapa

#2へのコメントから、対象のファイルは
文字コードがANSI限定のようですので、
次のようなコードでイケルと思います。

Sub Sample1()

　Dim buf As String
　Dim Target

　Target = _
　　Application.GetOpenFilename(Filefilter:="ansiのテキストファイル,*.txt")
　If Target = False Then Exit Sub

　With CreateObject("ADODB.Stream")
　　.Charset = "Shift_jis"
　　.Open
　　.LoadFromFile Target
　　buf = .ReadText
　　.Close
　　.Open
　　.writetext ChgKana(buf)
　　.savetofile Target, 2
　　.Close
　End With

End Sub

Function ChgKana(text As String) As String

　Dim MyLen As Long
　Dim wkStr As String
　Dim i As Long
　MyLen = Len(text)

　wkStr = ""
　For i = 1 To MyLen
　　If ( _
　　　 (Asc(Mid(text, i, 1)) >= 166) And _
　　　 (Asc(Mid(text, i, 1)) <= 221)) Then
　　　wkStr = wkStr & " "
　　Else
　　　wkStr = wkStr & Mid(text, i, 1)
　　End If
　Next i
　ChgKana = wkStr

End Function

なお、変換元のファイルを上書きしていますので
予めバックアップを取得してから実行してください。

お礼

HohoPapaさん、別回答感謝します。

早速、いただいたコードを起動して
ANSIで出力されるのを確認しました。

ただ、以下の左上に丸が変換できれば完璧です。
（必要ない丸が残りました。）

ﾟ

（この丸のコードは？）

-------------------------
宜しければ、No.3のお礼で提示した
　無駄な改行を削除するための処理を教えて下さい。

回答No.3

imogasi

コンピュータ―を触るものとして、質問の表現の厳密さを欠く。
＞ネットで検索しても同じ項目が探しきれませんでした
ぴったり同じというのは少ないだろう。どういう語句で検索するか、だ。
また文字種の判定や変換は、（初心者には、今までの勉強コースに入っておらず）難しい背景知識が要るのだが。
また「正規表現」などというのもWEB照会した？語句も知らなければ、照会しようもない。
色々な表法があるのでまた目移りがする。
今回のスペ-スに置き換え、課題のほかに、判定・変換・削除などもあるし。
ーー
また
＞テキストファイル
どのソフトで扱う途中での話か書いてない。
下記はエクセルのシートに読みこんであるものとしたが、何でもエクセルではないよ。そうでないことが多いだろう。
例えば、メモ帳に表示してあるとか、ワードに読みだしてあるとか、そんなことであれば、難しさを
加える。
ーーー
簡単ケースを取って、
シートのA列に文章があるとして（本件骨子はLile演算子の利用です）
標準モジュールに
Sub test01()
For i = 1 To 2
x = Cells(i, "A")
'MsgBox x
For j = 1 To Len(x)
y = Mid(x, j, 1)
' MsgBox y
If y Like "[ｦ-ﾟ ]" Then
'MsgBox "半角カナ"
s = s & " "
Else
s = s & y
End If
Next j
Cells(i, "B") = s
s = ""
Next i
End Sub
ーーー
例文　A列　各処理結果B列
大きなｶｯﾌﾟがあります 　　　大きな があります
ﾛｽｱﾝｼﾞｪﾙｽ郊外にありました　　　 郊外にありました
ーーー
https://tools.m-bsys.com/data/charlist_ascii_kana.php
にあるコード表を参考にしたが、コード表で、半角カタカナの最初文字と最終文字が、小生は、慣れないので自信ない。
ーーー
半角カタカナ文字の入力は、
全角カタカナ・ひらがなモードで、キーボードをもとにカナ文字を出し、F8キーで半角に変換するのが
例題を作るときに良いようだ。
今でも、世の中に、そういう（半角カタカナ）データが作られているのかな。
全角文字や全角文字の印字や画面表示がなかった４０年以上前を思い出す。

お礼

imogasiさん、回答ありがとうございます。

imgasiさんの回答は、いつも辛口ですね。

検索でそのものずばりがヒットする事は少ないのは心得ています。
（検索知識は、だいぶ上達したのでそれなりのヒットはします。）

>どのソフトで扱う途中での話か書いてない。

　　単にテキスト内の見た目を変えるだけの変換で
　　　次に使うソフトなどはありません。

教えてもらったコードで処理はできました。

sample1()を参照ください。

現在、無駄な改行を削除するために
以下のURLを参考にしましたが、旨く処理できません。
なぜでしょうか？

https://vbabeginner.net/delete-blank-lines-and-fill-lines/

Sub Sample1()
Dim i As Single
Dim j As Single
Dim SelectyFile As Variant
Dim LastRow As Single

Dim s '// セル値
Dim iRow '// 行位置
Dim iCol '// 列位置
Dim iMaxRow '// シートでの最終行

ChDir "C:\Users\NuNu\Desktop"
SelectFile = Application.GetOpenFilename("txtファイル(*.txt),*.txt")

If VarType(SelectFile) = vbBoolean Then
MsgBox "キャンセルされました"
Else
'MsgBox SelectFile & " が選択されました"
Open SelectFile For Input As #1
End If

Do Until EOF(1)
Line Input #1, buf
n = n + 1
Cells(n, 1) = buf
Loop
Close #1

LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row

For i = 1 To LastRow
x = Sheet1.Cells(i, "A")
'MsgBox x
For j = 1 To Len(x)
y = Mid(x, j, 1)
' MsgBox y
If y Like "[ｦ-ﾟ ]" Then
'MsgBox "半角カナ"
s = s & " "
Else
s = s & y
End If
Next j
Sheet2.Cells(i, "A") = s
s = ""
Next i

Stop

'Application.ScreenUpdating = False

Sheet2.Activate

iRow = ActiveCell.row
iCol = ActiveCell.Column
iMaxRow = ActiveSheet.UsedRange.row + ActiveSheet.UsedRange.Rows.Count - 1

'// アクティブ列の行をループ
Do
If (ActiveCell.row > iMaxRow) Then
Exit Do
End If

s = ActiveCell.Value

'// セル値が未設定の場合
If (s = "") Then
'// 空行削除
ActiveCell.EntireRow.Delete

'// 削除により最終行が上に移動するため値を調整
iMaxRow = iMaxRow - 1
Else
'// 次行に選択セルを変更する
ActiveCell.Offset(1, 0).Select
End If
Loop

'// 初期選択位置を選択
Cells(iRow, iCol).Select

'Application.ScreenUpdating = True

End Sub

回答No.2

kon555

開いた後のファイルの取り扱いとか、どんな容量のテキストデータかで変わりますね。
　まあコード的に簡単なのは以下の形ですかね。処理的な部分とか、保守的な部分は別として。
1.FileSystemObjectでテキストファイル一括読み込み
2.Replaceで半角ア～ンまでを半角スペース置換

参考ページ
http://officetanaka.net/excel/vba/file/file08b.htm
http://officetanaka.net/excel/vba/function/replace.htm

お礼

以下のコードを考えました。

”土屋"の所が半角カナコードに該当すると思うのですが
　どうすれば良いでしょうか　？

Sub Sample1()
Dim i As Single
Dim SelectyFile As Variant
Dim LastRow As Single

ChDir "C:\Users\Nubo\Desktop"
SelectFile = Application.GetOpenFilename("txtファイル(*.txt),*.txt")

If VarType(SelectFile) = vbBoolean Then
MsgBox "キャンセルされました"
Else
'MsgBox SelectFile & " が選択されました"
Open SelectFile For Input As #1
End If

Do Until EOF(1)
Line Input #1, buf
n = n + 1
Cells(n, 1) = buf
Loop
Close #1

LastRow = Cells(Rows.Count, "A").End(xlUp).row

For i = 1 To LastRow
Cells(i, 1) = Replace(Cells(i, 1), "土屋", " ")
Next i
End Sub

回答No.1

Nebusoku3

こちらのコードを使えば、VBAでの変換に使えるのではないでしょうか。
↓
https://tools.m-bsys.com/data/charlist_ascii_kana.php

補足

回答感謝します。

技術系の知識が不足していて
　提示いただいた一覧表をどのように生かすのか？
　　追いつきません。

　よろしければ、もう少しアドバイスいただけますか？