シート内のひらがなを全て削除したい

質問

こんばんは。エクセル２００３です。

シート内の全てのひらがなを削除して
英数字、漢字、記号のみを残したいのですが
Cells.Replace what:="あ", Replacement:="", LookAt:=xlPart
Cells.Replace what:="い", Replacement:="", LookAt:=xlPart
Cells.Replace what:="う", Replacement:="", LookAt:=xlPart
・
・
・
Cells.Replace what:="ん", Replacement:="", LookAt:=xlPart
とやっていくしかないでしょうか？
何か効率のいい方法があれば教えて頂ければ助かります。
よろしくお願いします。

回答No.6

mitarashi · ベストアンサー

完全に趣味の世界に入っておりますが、もっと速くならないかと、フリーのC/C++コンパイラ（BCC）で、ふりがなカット専用の関数(DLL)を作成してみました。C/C++は時々思い出したように勉強する万年初心者ですので、1日かかりましたが、#4の方法の5938msec → 4484msec に改善されました。ただ、関数を呼ぶVBAの方の作り方だけでも簡単に逆転してしまい、期待外れでした。（DLLの方も拙作だと思います）
#4の方法は、そこそこ速いのだというのが結論です。

お礼

何度もありがとうございます。
大変参考になりました。
私もそれくらい好きになりたいです。

回答No.5

mitarashi

#3&4です。確認不足ですみません。下から五行目の、
buf = Replace(buf, Mid(buf, i, 1), "", , 1)
は消し損ないですので削除願います。

お礼

わかりました。ありがとうございます。

回答No.4

mitarashi

#3です。#1の方の方法の応用編も試してみましたので、報告まで。
Midでループを回すので、余り期待しておりませんでしたが、5秒前後とずっと速かったです。更に、位置決め打ちのワークシート関数ならもっと速くなるかと試してみましたが、13秒程度と逆に遅くなってしまいました。
Private Function funcReplaceKANA(targetString As Variant) As String
Dim buf As String
Dim i As Long
Dim charCode As Long
Dim myChar As String

buf = targetString
For i = Len(buf) To 1 Step -1
myChar = Mid(buf, i, 1)
charCode = Asc(myChar)
If (charCode <= -32015) And (charCode >= -32097) Then
buf = Replace(buf, myChar, "", , 1)
' buf = Application.WorksheetFunction.Replace(buf, i, 1, "")
buf = Replace(buf, Mid(buf, i, 1), "", , 1)
End If
Next i
funcReplaceKANA = buf
End Function

お礼

何度もありがとうございます！

回答No.3

mitarashi

おもしろ半分でやってみました。お陰で明日は寝不足です。
http://hp.vector.co.jp/authors/VA023000/soft/zipcode.html
から、ハイフン無し郵便番号辞書をダウンロードして、
090331_M.txt　をエクセル2000に読み込んで試してみました。全部は読み込めないので、65536行×3列のデータです。2列目には若干、3列目には必ずひらがなが入っています。5年位前の遅いCeleronで、24秒弱かかりました。
Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim regEx As Object

Sub replaceKANA()
Dim targetString As String, patternString As String
Dim startTime As Long
Dim buff As String
Dim targetRange As Range
Dim tempArray As Variant
Dim myRow As Long, myColumn As Long

startTime = GetTickCount
Application.ScreenUpdating = False
Set targetRange = ActiveSheet.UsedRange
Set regEx = CreateObject("VBScript.RegExp")

tempArray = targetRange
For myRow = 1 To UBound(tempArray, 1)
For myColumn = 1 To UBound(tempArray, 2)
tempArray(myRow, myColumn) = funcReplaceKANA(tempArray(myRow, myColumn))
Next myColumn
Next myRow
targetRange = tempArray
Application.ScreenUpdating = True
Debug.Print GetTickCount - startTime 'msec
Set regEx = Nothing
End Sub

Private Function funcReplaceKANA(targetString As Variant) As String
Dim patternString As String
Dim Matches As Object, match As Object
Dim buf As String

buf = targetString
patternString = "([ぁ-ん]+)"
regEx.MultiLine = False
regEx.Pattern = patternString
regEx.IgnoreCase = False
regEx.Global = True
Set Matches = regEx.Execute(buf)
If Matches.Count > 0 Then
For Each match In Matches
regEx.Pattern = match.subMatches.Item(0)
buf = regEx.Replace(buf, "")
Next match
funcReplaceKANA = buf
Else
funcReplaceKANA = targetString
End If
Set Matches = Nothing
Set match = Nothing
End Function

お礼

すごいです！できました！
寝不足のところありがとうございます。

回答No.2

imogasi

操作でやる話だが
ワードは正規表現まがいの検索・置換機能が有る。２０００ぐらいからかな。
エクセルシートの範囲をワードの表にコピー貼り付け。
置換
検索する文字列　[あ-ん] []-は半角（正確には小文字の「ぁ」から、「ん」まで（文字一覧から）
置換後の文字列　何も入れない
オプションをクリック
ワイルドカードを使用するにチェック。
全てを置換。
これをコピーしエクセルの任意のセル（を左上隅として）に貼り付ける。
ワードでマクロの記録をとればワードVBAでコードはわかると思う。
＝＝＝
またはエクセルVBAでVBScriptを使う方法もある。
RegExp
http://officetanaka.net/excel/vba/tips/tips38.htmScriptingObjec
WEBを探せばコード例が有ると思うが。

お礼

ちょっと私には難しいですね。調べてからやってみます。ありがとうございます。

回答No.1

suo2k

文字コードを指定して、for文でまわせば短縮できますし、応用もききやすいです。
ひらがなの文字コード…が -32097 ～ -32015 （小さい ぁ ～ ん）かな

なので例として
--------------------------
Dim i As Long
Dim moji As String

For i = -32097 to -32015
moji = chr(i)
Cells.Replace what:=moji, Replacement:="", LookAt:=xlPart
next i
--------------------------
こんな感じ？

replaceの後にでも
msgbox "「" & moji & "」を削除しました"
とか入れておくとテストするとき何の文字を置換したか確認できて良いと思います。

お礼

危うく非効率な作業をやるとこだったので質問してよかったです！
大変参考になりました。ご回答ありがとうございます。