[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『漢字・ひらがなを削除しカタカナのみにしたい』（タケキ）
A1セル欄の漢字とひらがなを削除し、カタカナのみにする方法はありますか。
例：
A1：
ソフトウェアの開発
を
B2では：ソフトウェア
OSはXPのSP3
Excel2003
どちらも英語版です。
よろしくお願いいたします。
英語版で出来るのかわかりませんが ユーザー定義関数で
Function Kana(MyStr As Variant) As String
Dim MyReg As Object
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "[ｦ-ﾟァ-ヶー]+"
For Each MyReg In .Execute(MyStr)
Kana = Kana & MyReg.Value
Next MyReg
End With
End Function
を標準モジュールに入れて B2=Kana(A1) とかしてみたらどうでしょうか？ （ｍｏｍｏ）
Function except_kh(ByVal mystr As Variant) As String
Dim g0 As Long
except_kh = ""
For g0 = 1 To Len(mystr)
If StrConv(Mid(mystr, g0, 1), vbNarrow) <> StrConv(Mid(mystr, g0, 1), vbWide) Then
except_kh = except_kh & Mid(mystr, g0, 1)
End If
Next
End Function
b1に =except_kh(a1)
これでは？
ichinose
やっぱり手元に英語版がないと中々大変ですねえ！！ Function except_kh(ByVal mystr As Variant) As variant
と変えてみるとか・・・。 If StrConv(Mid(mystr, g0, 1), vbNarrow) <> StrConv(Mid(mystr, g0, 1), vbWide) Then
を
If StrConv(Mid(mystr, g0, 1), 8) <> StrConv(Mid(mystr, g0, 1), 4) Then
に変えるとか・・・。
工夫してみてください
ichinose
こんにちは
アルファベットも除いて、カナの後ろの全角濁点とかは残してます。
Public Function KanaNomi(ByVal mSt As Variant) As Variant
Dim r As String
Dim s As String
Dim t As Long
Dim u As String
If VarType(mSt) <> 8 Then
KanaNomi = ""
Exit Function
End If
Do Until mSt = ""
r = Left(mSt, 1)
s = Mid(mSt, 2, 1)
mSt = Right(mSt, Len(mSt) - 1)
Select Case r
Case Chr(-32097) To Chr(-32015)
Case "A" To "Z", "a" To "z", "Ａ" To "Ｚ", "ａ" To "ｚ"
Case "0" To "9", "０" To "９"
Case " ", " "
Case Else
t = Asc(StrConv(r, 4))
Select Case t
Case -31936 To -31850
Select Case StrConv(s, 8)
Case Chr(&HA1) To Chr(&HDF)
u = u & r & s
mSt = Right(mSt, Len(mSt) - 1)
Case Else
u = u & r
End Select
End Select
End Select
Loop
KanaNomi = u
End Function
（ウッシ）
>＃Valueが出てしまいました。 では、これでどこでエラーになりますか？ 標準モジュールに
'===============================================
sub test1()
msgbox except_kh("aaa")
end sub
sub test2()
msgbox except_kh(range("a1").value)
'セルA1には、ソフトウェアの開発 という文字列が入力されているとして
end sub
Function except_kh(ByVal mystr As Variant) As variant
Dim g0 As Long
except_kh = ""
For g0 = 1 To Len(mystr)
If StrConv(Mid(mystr, g0, 1), 8) <> StrConv(Mid(mystr, g0, 1), 4) Then
except_kh = except_kh & Mid(mystr, g0, 1)
End If
Next
End Function
test1 、test2を実行してみてください。
結果は、いかがですか？ エラーになるなら、どこでエラーになりますか？
ichinose
こんにちは 済みません、自分のも英語版で書いた訳じゃないのでどこかダメなんですね。 ブレークポイント設定して1ステップずつ動かしてもらうと原因が分かるかも・・・ （ウッシ）
また、このテストがウッシさんのブレークポイントの質問にもお答えできてればいいのですが。正しい操作か分かりませんが、ウッシさんの書かれた式をVBAのF8でステップインしても反応がでませんでした。FYI:以前のKanaNomiですが、Alt+F8マクロに表示されないのでユーザー定義関数で試したのですが、その結果が＃Valueでした。
StrConv関数がない？
一応、以下のtest1〜test4も実行して、test1,test2にエラー、test3が正常作動することを 確認してください。
Sub test1()
MsgBox StrConv("aaa", 4)
End Sub
Sub test2()
MsgBox StrConv("ａａａ", 8)
End Sub
Sub test3()
MsgBox Mid("aaa", 1, 1)
End Sub
上記の実行結果が仮説どおりなら・・・、
Sub samp1()
MsgBox except_kh("aaa")
End Sub
Sub samp2()
MsgBox except_kh(Range("a1").Value)
'セルA1には、ソフトウェアの開発 という文字列が入力されているとして
End Sub
Function except_kh(ByVal mystr As Variant) As Variant
Dim g0 As Long
except_kh = ""
For g0 = 1 To Len(mystr)
If Application.Asc(Mid(mystr, g0, 1)) <> Application.Dbcs(Mid(mystr, g0, 1)) Then
except_kh = except_kh & Mid(mystr, g0, 1)
End If
Next
End Function
このsamp1,samp2の結果は、どうなりますか？ これもエラーになるなら、まったく別の方法をかんがえなければなりませんねえ
ichinose
Sample1はaaa
Sample2は??????
のWindowsのポップアップが出てきます。
ん？ test3でエラー？ でsamp1で正常に表示？ おかしいな・・・。 因みにtest1,test2は、エラーになったのですか？
それと、セルA1に ソフトウェアの開発 と入力されていた場合の
Function except_kh(ByVal mystr As Variant) As Variant
Dim g0 As Long
except_kh = ""
For g0 = 1 To Len(mystr)
If Application.Asc(Mid(mystr, g0, 1)) <> Application.Dbcs(Mid(mystr, g0, 1)) Then
except_kh = except_kh & Mid(mystr, g0, 1)
End If
Next
End Function
このコ-ドを生かした場合の
セルB1に =except_kh(a1)
では？
ichinose
内訳：
どうやら
Function except_kh(ByVal mystr As Variant) As String
から
Function except_kh(ByVal mystr As Variant) As Variant
にしたら出来たということですね。Momoさんのは文字化けが理由かもしれませんが、ウッシさんのはなぜだめだったのか。
英語版のせい（たぶん）で大変お手数おかけしましたが。皆さんには大感謝です！本当にありがとうございました。
こんにちは
StrConv が無いのですか・・・
Public Function KanaNomi(ByVal mSt As Variant) As Variant
Dim r As String
Dim s As String
Dim t As Long
Dim u As String
If VarType(mSt) <> 8 Then 'ここを選択してF9を押す
KanaNomi = ""
Exit Function
End If
Do Until mSt = ""
r = Left(mSt, 1)
s = Mid(mSt, 2, 1)
mSt = Right(mSt, Len(mSt) - 1)
Select Case r
' Case "ぁ" To "ん"
Case Chr(-32097) To Chr(-32015)
Case "A" To "Z", "a" To "z", "Ａ" To "Ｚ", "ａ" To "ｚ"
Case "0" To "9", "０" To "９"
Case " ", " "
Case Else
t = Asc(Application.Dbcs(r))
Select Case t
Case -31936 To -31850
Select Case Application.Asc(s)
Case Chr(&HA1) To Chr(&HDF)
u = u & r & s
mSt = Right(mSt, Len(mSt) - 1)
Case Else
u = u & r
End Select
End Select
End Select
Loop
KanaNomi = u
End Function
ユーザー定義関数なのでステップインではなくてF9で適当な位置にブレークポイントをセットしておいてから
セルA1には、「ソフトウェアの開発ヴンABC」、セルＢ1に「=KanaNomi(A1)」と入力すると、ブレークポイントで
中断しますので、そこからF8でステップ実行します。
（ウッシ）
もう仕事にはいってしまったので、簡単ですが・・・。
>どうやら Function except_kh(ByVal mystr As Variant) As String から Function except_kh(ByVal mystr As Variant) As Variant にしたら出来たということですね。
これも検証してもらわなければはっきりしませんが、多分、違うと思います。
エラーの原因は、Strconvという便利な関数が日本語版にはあります。これが使えないことが大きな原因だと思います。 今回、訂正したexcept_kh関数では、代わりの関数を使いました。
それときちんと文字コードを調べなければはっきりは言えませんが、 漢字、ひらがな、カタカナがUnicode扱いなのかなあ という想像です。 よって、Msgboxでは、?????? と表示されたのではないかと・・・。
日本語版でもUnicode文字は、VBAのmsgboxでは? で表示されます。 この文字コードの件は、日本語版だけでも 難しいですからね！！
ichinose
Case "ぁ" To "ん"
が
Case "?" To "?"
になっています。
Ichinoseさん：なるほど。英語版を使っているとUnicodeの問題は多いです。アプリとかで。これもその一環なのかもしれないということですね。
Strconvという関数が使える日本版でないと今回みたいに質問したとき皆さんが大変ですね。。とりあえず今後は「英語版なのでStrconvが使えません」と一言付け加えるとある程度皆さんの手間を省くことができるかもしれない、ということ学びました。
タケキ
こんにちは コメントアウトしてあってもダメなんですね。 その行を削除して下さい。 （ウッシ）
タケキさんへ ヴ に関しては、ヴという文字か否かのチェックを追加すればよいのですが、 VBAを勉強して追加してみてください。
それと私は、英語版なるものは見たこともないので後学のために以下の結果を はっきり教えてほしいのですが、お願いできますか？
新規ブックにて、標準モジュール
Option Explicit
Function ucode(mystr As Variant) As Long
ucode = AscW(mystr)
End Function
Function sjcode(mystr As Variant) As Long
sjcode = Asc(mystr)
End Function
としておいて、適当なシートに
Ａ Ｂ Ｃ Ｄ １ 田 =code(a1) =sjcode(a1) =ucode(a1) ２ あ =code(a2) =sjcode(a2) =ucode(a2) ３ ア =code(a3) =sjcode(a3) =ucode(a3) ４ ｱ =code(a4) =sjcode(a4) =ucode(a4)
セル Ａ１〜Ａ４に それぞれ 田、あ、ア、ｱ（半角のカタカナ）を 入力し、 Ｂ列には、CODE関数、Ｃ列には、ユーザー定義のsjcode、 Ｄ列にはユーザー定義のucode の結果を教えてください。
仮説では、Ｂ列、Ｃ列は、全部 63、Ｄ列は、Ｄ１〜Ｄ４でそれぞれ 30000、12354、12450、-143 となると思っているのですが・・・。
結果を教えて頂けませんか？
ichinose@訂正9-25 13:10
Dim orig_chr As String
Dim out_chr As String
Dim kana_chr As String
Dim ll As Integer
Dim zz As Integer
orig_chr = Range("a1")
out_chr = ""
For zz = 1 To Len(Range("a1"))
kana_chr = Mid(orig_chr, zz, 1)
If Asc(kana_chr) >= 12449 And Asc(kana_chr) <= 12538 Then
out_chr = out_chr & kana_chr
End If
Next
Range("B1") = out_chr
End Sub
'' *******
'' Unicode表 参考場所
'' http://www.m-hoz.com/jsp/unicode.jsp?Bgn=0&End=65536
(caro) 2010.09.25 11:45
※番外 kazu様
数年振りに通りかかりました。
お元気そうでなによりです。
ウッシさん：
（セルA1には、「ソフトウェアの開発ヴンABC」、セルＢ1に「=KanaNomi(A1)」で）
Case Chr(-32097) To Chr(-32015) の手前で止まりました。この行を削除したら最後までいけましたが、B1の値は "0"になりました。ちなみに ' の付いたコメントは大丈夫でした。見間違ってしまってすみません。
Ichinoseさん：頂いた表の結果ですが、以下のとおりです。
Ａ Ｂ Ｃ Ｄ
1 田 63 32 12288
2 あ 49 49 49
3 ア 50 50 50
4 ｱ 51 51 51
仮説とは違う結果のようです。（表示が変でしたらすみません）
勉強の件、そうですね。これを機にVBAの勉強をしていきたいと思います。まずは「ヴ」からですね。
Caroさん：セルA1に「ソフトウェアの開発ABCヴ」でマクロ名 "Unicode_kana" を実行しましたが、変化なしでした。ですがエラーも出ませんでした。もし間違った操作でしたらお知らせください。
タケキ
If Asc(kana_chr) >= 12449 And Asc(kana_chr) <= 12538 Then を If AscW(kana_chr) >= 12449 And AscW(kana_chr) <= 12538 Then に変えてみて下さい。
当方、英語版でないので検証出来ません。(推測で書いております)
(caro) 2010.09.28 6:25
>仮説とは違う結果のようです。 ですね！！英語版の文字コード体系に関しては、予想がはずれました・・・。 この結果だと、いまところ、推測が難しいです。
「文字コードに関する予想がはずれる可能性も結構あるだろうなあ」という 予想もしていました。
よって、文字コードを調べるようなプログラムには、 今回はしなかったのですが・・・。 提示したプログラムは、Excelの持つ機能に賭けた結果でした。 これだって、根拠があってのことではありません。偶然、たまたまでした。
英語版の文字コードに関して、ちょこっと検索してみましたが、これだという 内容は見つけられませんでした。
英語版を使うチャンスが持てるなんて貴重ですね！！ おもしろいことを発見されたらまた教えてください。
ichinose
こんにちは
文字コード調べて、っていうのはやっぱりダメなのかな・・・
Public Function KanaNomi(ByVal mSt As Variant) As Variant
Dim r As String
Dim s As String
Dim t As Long
Dim u As String
If VarType(mSt) <> 8 Then
KanaNomi = ""
Exit Function
End If
Do Until mSt = ""
r = Left(mSt, 1)
s = Mid(mSt, 2, 1)
mSt = Right(mSt, Len(mSt) - 1)
Select Case AscW(Application.Dbcs(r))
Case -32097 To -32015, 12353 To 12435
Case -32160 To -32135, -32127 To -32102, -223 To -198, -191 To -166
Case -32177 To -32168, -240 To -231
Case -32448, 12288
Case -31936 To -31850, 12449 To 12534
If s <> "" Then
Select Case AscW(Application.Dbcs(s))
Case -32446 To -32437, 12290 To 12444
u = u & r & s
mSt = Right(mSt, Len(mSt) - 1)
Case Else
u = u & r
End Select
Else
u = u & r
End If
End Select
Loop
KanaNomi = u
End Function
（ウッシ）
Ichinoseさん：英語版＋VBAの初心者＋実は時差もあり、なかなかスムーズに行かないにもかかわらず気長に教えていただきとても大感謝です！操作方法などを含め大変勉強になりました。サイト名どおり。また何かあれば、よろしくお願いいたします。（まずは自分である程度勉強もしないとですね）。
ウッシさん：機能しました！ヴも表示されますね。ただカタカナの右にあるひらがな一文字が表示されるようです。
例：
ソフトウェアの開発ABC = ソフトウェアの
カタカナ漢字ひらがな = カタカナ
カタカナひらがな = カタカナひ
文字コード調査の件、素人リサーチですが、エクセルのデフォルト エンコーディング は "ANSI" -- というのを見ました。的大外れ（汗）かもしれませんがNotepadでもデフォルトがANSIになってまして、これだと日本語が読めないのでUTF-８かUnicodeにして保存しています。 またVBAはASCII Valueだというのも見ました。
タケキ
caroさんの
if AscW(kana_chr) >= 12449 この変更で作動するなら、予想通りなんですが、
> Ａ Ｂ Ｃ Ｄ
>1 田 63 32 12288
>2 あ 49 49 49
>3 ア 50 50 50
>4 ｱ 51 51 51
この結果が気になりますねえ。
ichinose
こんにちは
濁点、半濁点個別に調べなきゃいけないのに幅で指定してました。
Public Function KanaNomi(ByVal mSt As Variant) As Variant
Dim r As String
Dim s As String
Dim t As Long
Dim u As String
If VarType(mSt) <> 8 Then
KanaNomi = ""
Exit Function
End If
Do Until mSt = ""
r = Left(mSt, 1)
s = Mid(mSt, 2, 1)
mSt = Right(mSt, Len(mSt) - 1)
Select Case AscW(Application.Dbcs(r))
Case -32097 To -32015, 12353 To 12435
Case -32160 To -32135, -32127 To -32102, -223 To -198, -191 To -166
Case -32177 To -32168, -240 To -231
Case -32448, 12288
Case -31936 To -31850, 12449 To 12534
If s <> "" Then
Select Case AscW(Application.Dbcs(s))
Case -32446, -32438, 12443, 12444
u = u & r & s
mSt = Right(mSt, Len(mSt) - 1)
Case Else
u = u & r
End Select
Else
u = u & r
End If
End Select
Loop
KanaNomi = u
End Function
（ウッシ）
ソフトウェアー開発ABCヴン = ソフトウェアヴン
ルーター = ルタ
タケキ
こんにちは
長音符でなくてマイナスやダッシュで書かれたり、ひらがなの間とか後ろの長音符とか、
数字の中のマイナスとか長音符なんて、考え出すときりがないですね。
Public Function KanaNomi(ByVal mSt As Variant) As Variant
Dim r As String
Dim s As String
Dim t As Long
Dim u As String
If VarType(mSt) <> 8 Then
KanaNomi = ""
Exit Function
End If
Do Until mSt = ""
r = Left(mSt, 1)
s = Mid(mSt, 2, 1)
mSt = Right(mSt, Len(mSt) - 1)
Select Case AscW(Application.Dbcs(r))
Case -32097 To -32015, 12353 To 12435, _
-32177 To -32168, -240 To -231
If s <> "" Then
Select Case AscW(Application.Dbcs(s))
Case -32421 To -32419, -32388, _
12540, -243, 8208, 8213
mSt = Right(mSt, Len(mSt) - 1)
End Select
End If
Case -32160 To -32135, -32127 To -32102, -223 To -198, -191 To -166
Case -32448, 12288
Case -31936 To -31850, 12449 To 12534, _
-32421 To -32419, -32388, _
12540, -243, 8208, 8213
If s <> "" Then
Select Case AscW(Application.Dbcs(s))
Case -32446, -32438, 12443, 12444
u = u & r & s
mSt = Right(mSt, Len(mSt) - 1)
Case Else
u = u & r
End Select
Else
u = u & r
End If
End Select
Loop
KanaNomi = u
End Function
確認用
Sub test1()
Dim v As Variant
v = KanaNomi("ぱーソフトウェアー−-―‐開発ヴンABCプﾌﾟーﾊﾞーﾝAAぱーぱん青ｄ(12-ソ5)")
MsgBox v
End Sub
（ウッシ）
ぱーソフトウェアー−-―‐開発ヴンABCプﾌﾟーﾊﾞーﾝAAぱーぱん青ｄ(12-ソ5)
が
ソフトウェアー−-―‐ヴンプﾌﾟーﾊﾞーﾝソ
ひらがなや半角数字の後の長音符等は削除されますが、カタカナの後のはしっかり残ってます。キリがないとおっしゃりつつもここまで突き詰めてやられたウッシさんには本当に脱帽です。
これはもう完全版ですね！
本当にありがとうございました！！！！
タケキ
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.