エクセル2016を使っております。
あるファイルで氏名でVLOOKUP関数を使い値を取得したいのですが、旧字体・異字体が混ざっており、適切に値が取得できません。
VBAで一括変換したく、ネットで調べながら以下のコードをThisworkbookのモジュールに書いて実行したのですが、動きません。
いろいろとおかしいと思うので、ご教示願います。
Sub macro1()
Dim str As String
Call ChangeName
End Sub
Function ChangeName() As String
strName = Replace(strName, " ", "") '全角空白を半角空白に変換
strName = Replace(strName, "髙", "高")
strName = Replace(strName, "邊", "辺")
strName = Replace(strName, "邉", "辺")
strName = Replace(strName, "愼", "慎")
strName = Replace(strName, "將", "将")
strName = Replace(strName, "聰", "聡")
ChangeName = strName
End Function
No.4ベストアンサー
- 回答日時:
>他の列にも対応させるには、
でコードを書いていらっしゃいますが、基本的にも考え方も間違っていません。
フリーズの要素は、別にあるのだと思います。それがなんなのかが分かりませんので、あえてジャンプ機能を使って(定数かつ文字列)であるなら、置換を試みる方法でやってみます。範囲の選択は不要です。
SpecialCells(xlCellTypeConstants, xlTextValues).Cells
'//
Sub Macro2()
Dim c As Variant
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange. _
SpecialCells(xlCellTypeConstants, xlTextValues).Cells
c.Value = ChangeName(c.Value)
Next c
Application.ScreenUpdating = True
End Sub
もし、これで不具合が出るようですと、ひとつずつエラーになった原因を突き止めなくてはなりません。それと、元のソースが、ネットやWindows系以外のものですと、
ユーザー定義関数に渡す前に、
c.Value = ChangeName(c.Value)
↓
c.Value = ChangeName(Application.Clean(c.Value))
と、Clean 関数で、エスケープシーケンス等のバイナリコードを取り去ったほうがよい場合があります。
>「今の規模(100文字程度まで)なら、そのままでよいのですが、異字・旧字置き換え対象候補すべてで、1,400文字×2ぐらいが必要です。」の部分が理解できませんでした。
異字体、旧字の登録されているのが、調べてみると1083個、
元 |旧字・異字
------------
亜 |亞
唖 |啞 瘂
1083 →それぞれを展開させるので、
↓
上記から置換リストを作ります。(右:検索語, 左:置換語)
亜 |亞 ↓このように展開します。唖 は、2行になります。
唖 |啞
唖 |瘂
ざっと、1400漢字(内ダブリあり) 元の漢字に集約させるために、2行ないし3行にしてやる必要があります。検索語と置換語を併記して2列になります。それは、私にとってはあまりありがたくない話で、それは、今までのユーザー定義関数の方法ではおそらくダメだと思います。それにかなり気が滅入る作業の気がします。というよりも、私の集中力が落ちているせいなのですが。
ただ、私がこういうことに興味を持ったのは、Windowsが出る前のことで、今調べてみると、そんなに大きく変わっていないようです。その際は、前述で書いたようにbregexp.dll または、Basp21 をお薦めすることになります。
No.3
- 回答日時:
こんにちは。
>一つ目のコードで実行したところ、開いているシートにおける置換はうまくできたのですが、それ以外のシートには動いていないようでした。
簡単にどこでも使えるようにするには、「Personal.xlsb(マクロの記録の時に、『個人用マクロブック』と出てくる場所」の標準モジュールに同じように登録(貼り付け)します。名称は、Sub Macro1 ではなく、Sub 旧漢字変換() とでも分かりやすい名前がよいでしょう。ユーザー定義関数とセットにして貼り付けてください。
ファイル-オプション-クイックアクセスツールバー
で、「個人用マクロブック」で、Subプロシージャ名を選んであげれば、どこでも使えるようになります。「個人用マクロブック」は、プロシージャを貼り付けた時点で、Ctrl + Sで上書きすると、終了時にスムーズに終われます。
そのコード中で、
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
ただ、この部分は、
For Each c In Selection
にして、マウスで選択させるようにすればよいです。
それと、私がこの質問で気にしている部分は、どの程度の規模になるかということです。
確かに、今の規模(100文字程度まで)なら、そのままでよいのですが、異字・旧字置き換え対象候補すべてで、1,400文字×2ぐらいが必要です。
途中までリストは作ってみたものの、もし、そのぐらいの規模になれば、アドインにしなくてはならないことになります。
その場合は、再度、改めてコードを書き直します。(以前、同じような質問で、中途になってしまったものが開発中のままになっています。)
>2つ目のコードはインストールの部分が理解できずに諦めました。
かつては、bregexp.dll 一般のVB系プログラム本にも紹介されている公的なツールとして筆頭に挙げられたものです。Excelで正規表現を本格的に使うようであれば、インストールだけぐらいでしたら教えてさしあげてもよいのですが、ここの掲示板で、それを言っているのは私ぐらいでしかありません。
ありがとうございます。
おっしゃるとおり、「For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))」の部分は1列目でないと動作しないコードですね。
複数の様式の異なるシートにおいて動作させたいため、マウスで範囲選択するのは大変です。
他の列にも対応させるには、
For Each c In Range("C1", Cells(Rows.Count, 3).End(xlUp))
c.Value = ChangeName(c.Value)
Next c
For Each d In Range("G1", Cells(Rows.Count, 7).End(xlUp))
d.Value = ChangeName(d.Value)
Next d
For Each e In Range("B1", Cells(Rows.Count, 2).End(xlUp))
e.Value = ChangeName(e.Value)
Next e
というように追記すればよいのでしょうか?
(これで実行したところ、2回中、2回フリーズしましたが)
また、申し訳ないのですが、「今の規模(100文字程度まで)なら、そのままでよいのですが、異字・旧字置き換え対象候補すべてで、1,400文字×2ぐらいが必要です。」の部分が理解できませんでした。
No.2
- 回答日時:
#1で書いた通り
''標準モジュールに登録/ThisWorkbook モジュールではありません。
注意書きが書かれてもなお、Thisworkbookを使おうというのは、それが癖になっていませんか?
Excelでは、一般的に標準モジュールを使うようになっています。
Excelの表画面から、Alt + F11 -> Alt + I -> m (標準モジュール-挿入)
Excelでは、標準モジュールとそれ以外のオブジェクトモジュール(シート・Thisworkbook, Userform, Class) と別れます。後者は特別なイベント型のマクロを乗せます。Thisworkbook の本格的な使い方は、難易度がかなり高いです。
二つ目も当然、標準モジュールを使いますが、これは、Basp21 というツールをインストールしないと使えません。インストールができないのでしたら、諦めてください。
遅くなってすみません。
ボケていたようで、わざわざ標準モジュールと書いていただいていたのに、失敗していました。
申し訳ありませんでした。
一つ目のコードで実行したところ、開いているシートにおける置換はうまくできたのですが、それ以外のシートには動いていないようでした。
アクティブにしているシートだけではなく、このコードを書いたエクセルファイル全体に対して動かすことは可能ですか?
2つ目のコードはインストールの部分が理解できずに諦めました。
No.1
- 回答日時:
まず、掲示板のマクロコードの修正
''標準モジュールに登録/ThisWorkbook モジュールではありません。
'//
Sub macro1()
Dim c As Variant
Application.ScreenUpdating = False
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
c.Value = ChangeName(c.Value)
Next c
Application.ScreenUpdating = True
End Sub
Function ChangeName(ByVal strName As String) As String
If strName <> "" Then
strName = Replace(strName, Space(1), Space(1), , , vbTextCompare)
strName = Replace(strName, "髙", "高")
strName = Replace(strName, "邊", "辺")
strName = Replace(strName, "邉", "辺")
strName = Replace(strName, "愼", "慎")
strName = Replace(strName, "將", "将")
strName = Replace(strName, "聰", "聡")
ChangeName = strName
End If
End Function
'//
c.Value = Replace(buf1, Space(1), Space(1), , , vbTextCompare)
このコードは、テキストコンペアモードで、スペースを比較して、全角スペースを半角にするというコードです。デフォルトは、バイナリコンペアモードです。
人名漢字で、どの程度、旧漢字や異字体が出現するかにも依存しますが、
実際の表では、Perl やRuby などのほうが良いような気がします。
以前、Perl のExcel アドインがあると聞いたので、ずっと探したのですが、見当たりません。Perl もどきで、以下のような書き方が可能です。
http://www.hi-ho.ne.jp/babaq/basp21.html
2007/06/29版をインストール または、BREGEXP.DLL 単独をインストール(コードが変わります)このように書くことは可能になります。ただし、全ての旧漢字・異字体をカバーできるとは思えません。
'//
Sub BTranslateTest()
Dim bobj As Object
Dim c As Variant
Dim buf As String, buf1 As Variant '(Variant のみ)
Dim ret As Long
Set bobj = CreateObject("Basp21")
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
buf = c.Value
ret = bobj.Translate("tr/髙邊邉愼將聰/高辺辺慎将聡/kg", buf, buf1)
c.Value = Replace(buf1, Space(1), Space(1), , , vbTextCompare)
Next c
End Sub
ありがとうございます。
しかし、最初に書いていただいたプロシージャをthisworkbookに貼り付けて実行しようとしても、動きませんでした。。
また、2つめのSubプロシージャについても同様に実行しようとしたのですが、動きませんでした。
私の操作が違うのでしょうか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
違う字体の漢字をエクセルのVLOOKUP関数で一致させる。
Excel(エクセル)
-
外字をJIS水準内の文字に置き換えたい
その他(パソコン・スマホ・電化製品)
-
Excel上でどれが外字か調べたい
その他(コンピューター・テクノロジー)
-
-
4
Excel上に旧漢字を入力したい
Excel(エクセル)
-
5
VBAでListViewのフォントを変更する方法
Visual Basic(VBA)
-
6
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
7
エクセルで別ブックをバックグラウンドでオープンする方法
Excel(エクセル)
-
8
16進の10進変換について
Visual Basic(VBA)
-
9
Excelで名前リストに旧字体を使いたい
Excel(エクセル)
-
10
コンボボックス内の文字サイズ変更
Excel(エクセル)
-
11
アクセスで外字を探す方法
Access(アクセス)
-
12
StrConvでUnicodeに変換出来ない文字
Visual Basic(VBA)
-
13
Excel VBA ListViewサブアイテムの文字色
その他(プログラミング・Web制作)
-
14
Excel VBA 処理後データが重たくなる&処理スピードが遅いのを解決したい
Visual Basic(VBA)
-
15
vba 環境依存文字がListViewボックスに設定すると化ける
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel VBAでリンク切れをチェッ...
-
Excel VBAで、ユーザーフォーム...
-
vba 標準モジュールインポート...
-
シャープ製品JH-WB1821 と BCG...
-
Excel VBA 『Call』で呼び出す...
-
パワーポイントでマクロ(Auto_C...
-
ユーザー定義関数に#NAME?が返...
-
Access VBA標準モジュールにつ...
-
エクセルVBA クラスモジュール...
-
Excel VBA 定義されたプロージ...
-
グラフのX,Y座標を取得したい
-
Form間の値の渡し方
-
ExcelVBA:パブリック オブジェ...
-
システムエラーの内容
-
モジュールの最大数はいくつな...
-
VBでグローバル変数を宣言するには
-
モジュールからフォームのボタ...
-
Accessのパスワード保護された...
-
違うモジュールでも同じ変数を...
-
VBA This Workbookモジュール...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel VBAでリンク切れをチェッ...
-
エクセルVBAでシートモジュール...
-
VBでグローバル変数を宣言するには
-
Excel VBAで、ユーザーフォーム...
-
VBAで旧字体を異字体に一括で変...
-
ユーザー定義関数に#NAME?が返...
-
VBA This Workbookモジュール...
-
Excel VBA 『Call』で呼び出す...
-
【vba】フォームに書いてあ...
-
Access VBA標準モジュールにつ...
-
モジュールの最大数はいくつな...
-
'Range'メソッドは失敗しました
-
vba userFormのSubを標準モジュ...
-
VBAで別モジュールへの変数の受...
-
グラフのX,Y座標を取得したい
-
標準モジュールを削除したい。(...
-
VBAProjectのモジュ...
-
ExcelVBA:パブリック オブジェ...
-
Excel VBA 標準モジュール内で...
-
acwzlibとは?
おすすめ情報