ママのスキンケアのお悩みにおすすめアイテム

エクセル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

A 回答 (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 をお薦めすることになります。
    • good
    • 0
この回答へのお礼

詳しく教えていただきありがとうございます。
書いていただいたコードでうまく動きました。

お礼日時:2018/05/09 14:15

こんにちは。


>一つ目のコードで実行したところ、開いているシートにおける置換はうまくできたのですが、それ以外のシートには動いていないようでした。

簡単にどこでも使えるようにするには、「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で正規表現を本格的に使うようであれば、インストールだけぐらいでしたら教えてさしあげてもよいのですが、ここの掲示板で、それを言っているのは私ぐらいでしかありません。
    • good
    • 0
この回答へのお礼

ありがとうございます。

おっしゃるとおり、「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ぐらいが必要です。」の部分が理解できませんでした。

お礼日時:2018/05/08 18:31

#1で書いた通り



''標準モジュールに登録/ThisWorkbook モジュールではありません。
注意書きが書かれてもなお、Thisworkbookを使おうというのは、それが癖になっていませんか?

Excelでは、一般的に標準モジュールを使うようになっています。
Excelの表画面から、Alt + F11 -> Alt + I -> m (標準モジュール-挿入)

Excelでは、標準モジュールとそれ以外のオブジェクトモジュール(シート・Thisworkbook, Userform, Class) と別れます。後者は特別なイベント型のマクロを乗せます。Thisworkbook の本格的な使い方は、難易度がかなり高いです。

二つ目も当然、標準モジュールを使いますが、これは、Basp21 というツールをインストールしないと使えません。インストールができないのでしたら、諦めてください。
    • good
    • 0
この回答へのお礼

遅くなってすみません。
ボケていたようで、わざわざ標準モジュールと書いていただいていたのに、失敗していました。
申し訳ありませんでした。

一つ目のコードで実行したところ、開いているシートにおける置換はうまくできたのですが、それ以外のシートには動いていないようでした。
アクティブにしているシートだけではなく、このコードを書いたエクセルファイル全体に対して動かすことは可能ですか?

2つ目のコードはインストールの部分が理解できずに諦めました。

お礼日時:2018/05/04 15:18

まず、掲示板のマクロコードの修正



''標準モジュールに登録/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
    • good
    • 0
この回答へのお礼

ありがとうございます。
しかし、最初に書いていただいたプロシージャをthisworkbookに貼り付けて実行しようとしても、動きませんでした。。

また、2つめのSubプロシージャについても同様に実行しようとしたのですが、動きませんでした。

私の操作が違うのでしょうか。

お礼日時:2018/04/27 17:27

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

QAccess2010のVBAで異体字の記述

Windows7+Access2010のVBAで「JIS2004」の異体字168文字を記述していましたところ、不思議な事が起こりましたので質問です。

A.「屢」だけ「?」となり、記述できない。
  それ以外の異体字は正常に記述できる。
  現在は ChrW(&H5C62) と記述して逃げている。

A-1.なぜ記述できないのか、その原因は?
    バグなのか、環境変更、あるいはアップデートで回避できるか?
A-2.Windows7+Access2010で記述できるようにする方法はあるのか?
    無いのなら、Windows8+Access2013などなら、問題ないのか?

B.漢字をunicodeで指定するとした場合、異体字などに含まれる「叱(U+20B9F)」などは5桁コードだが、5桁以上のunicodeをVBAで表現したい場合はどのように処理するのか?
  ChrWやAscWでは正しく処理できない。

ネット検索もしてみましたが、なかなかヒットせず、時間ばかりかかっています。
どなたかご存知の方がいらっしゃいましたらよろしくお願いします。

Windows7+Access2010のVBAで「JIS2004」の異体字168文字を記述していましたところ、不思議な事が起こりましたので質問です。

A.「屢」だけ「?」となり、記述できない。
  それ以外の異体字は正常に記述できる。
  現在は ChrW(&H5C62) と記述して逃げている。

A-1.なぜ記述できないのか、その原因は?
    バグなのか、環境変更、あるいはアップデートで回避できるか?
A-2.Windows7+Access2010で記述できるようにする方法はあるのか?
    無いのなら、Windows8+Access2013などなら...続きを読む

Aベストアンサー

A.VBE(エディタ)は、Shift-JISみたいです
OfficeやVBAの文字列型はUnicodeなので、処理は可能です。
ただ、エディタがsjisなので、補助漢字はコード上に書くことができません。なぜかMsgBoxもsjisです。

 → 仕様かと。ChrWしかないと思います。
 参考)http://codezine.jp/article/detail/1718

B.VBAはサロゲートペア(4byte文字)未対応です
2byte*2として扱われます。

 → "

QExcelで名前リストに旧字体を使いたい

XP_ProでIMEもXP標準のものを使っています。
Excelでメンバーリストを作っているのですが、年配の方の名前に旧字体の
漢字を使っている人がいて、その漢字を出したいのですが、見当たりません。

旧字体ってインストールしないともともとは存在しないのですか?例えば
中国語のウィンドウズをインストールしたら旧字体もあるのでしょうか?
また、フリーで旧字体のあるフォントをダウンロードできる所を御存知でした
ら教えてください。

Aベストアンサー

こういう方法もあります。
例えば、「國」を使いたいとしますね。
そうすると、とりあえず、IMEパッドを使って新字体の「国」を探します。
見つけたらその文字の上で右クリックをし、出てきたメニューの中の「異字体の挿入」をポイントすると、その旧字体が表示されますので、その中から選択することもできます。

QエクセルのIF関数で、文字が入力されていたならば~

エクセルのIF関数で文字が入力されていたならば~、という論理式を組み立てたいと思っています。

=IF(A1="『どんな文字でも』","",+B1-C1)

A1セルに『どんな文字でも』入っていたならば、空白に。
文字が入っていなければB1セルからC1セルを引く、という状態です。

この『どんな文字でも』の部分に何を入れればいいのか教えてください。

またIF関数以外でも同様のことができれば構いません。

宜しくお願いします。

Aベストアンサー

=IF(ISTEXT(A1),"",B1-C1)

でどうでしょうか?

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QエクセルVBAのIf,Then 構文でOr条件とAnd条件の結合方法?

ワークシート関数で書けば
=IF(OR(F18=0,AND(F15>0,F16>0)),TRUE)です。
これをVBAで書こうとして

If Sheet1.Range("F18") = 0 Or Sheet1.Range("F15") > 0 And Sheet1.Range("F16") > 0 Then
MsgBox True
Else
MsgBox False
End If

とやってみたのですが、正しくないようです。
どのように書けばいいのでしょうか?

Aベストアンサー

>とやってみたのですが、正しくないようです。

式は正しいと思いますよ

ANDとORは、ANDが先に演算されます。/*と+-では、/*が先に演算されるようなものです。

でも、わかり易くするために、#1のかたのように括弧をつけるほうが良いですね。

QEXCELの文字列操作で文字数不足の分をスペースで補う方法

EXCELの文字データを取り出す際に以下のような操作を行いたいんですが、方法をご存知の方がいらっしゃいましたら教えていただけませんでしょうか。

既にデータの入力されているセルの文字数が、ある一定数に満たない場合は不足分を半角スペースで補う

【例】文字数を15と指定したとします
セルに入力されたデータ:山田_ 太郎
   ↓
求めたいデータ:山田_ 太郎_ _ _ _ _ _
(山田の後に半角スペースが1、太郎の後に半角スペースが6つ入っていると仮定してください)

※TEXT関数で数値の文字数不足分を0で埋めるということはできたのですが、TEXT関数は数値のみを対象としているようで・・・。
【例】12345 → 000000000012345

よろしくお願いいたします。

Aベストアンサー

A1に「山田 太郎」が入っている場合、
 =LEFTB(A1&REPT(" ",15),15)
と式を立てればOKです。

LEFBは、左側から指定バイト分(半角1バイト・全角2バイト)を抜き出す関数。
REPTは、所定の文字をくり返す関数です。

QVBA(エクセル)で自動的にボタンをクリックさせるには

いつもお世話になっております。
下記のことがしたいのですがどうやって良いのかがわからなくって困っております。

やりたいこと。
AブックとBブックが有るとします。(双方ともエクセルファイル)
エクセルのVBAで、Aブックのシート上のコマンドボタンを押すと
Bブックのシート上のコマンドボタンをクリックするという動きを
VBAでさせたいのですがどうしてもクリックさせることができません。

試したこと。
初めは、AのボタンをクリックするとBのボタンをセレクトして
SendKeysでENTERを送ってみたりしたのですがうまくいきませんでした。

何かやり方が有りましたら、お教えいただけませんでしょう。
宜しくお願いいたします。

Aベストアンサー

Privateスコープを変更しない場合、Application.Runメソッドを使う手もあります。
Application.Run "'C:\Book1.xls'!Sheet1.CommandButton1_Click"
※『Sheet1』の部分はシートモジュールのオブジェクト名になります。

ですが、Bブックのボタン_Clickの中味を標準モジュールに置いて、
AブックのボタンとBブックのボタンと、両方から実行できるようにしておくほうが良いような気もしますね。

(コマンドボタンが[フォーム]ボタンの事だったら、同じマクロを[マクロの登録]するだけの話?)

QVBAで文字列を数値に変換したい

A列とE列の文字列になってしまった数値を
数値に変換したく、以下のようなものを作ったのですが、
文字の無いセルまで、数値に変換しようとするので
時間がかなりかかります。
何かよい方法は無いでしょうか?
よろしくお願いいたします。


Sub 数値に変換()
Range("A:A,E:E").Select
For Each xCell In Selection
xCell.Value = xCell.Value
Next xCell
End Sub

使用ソフトEXCEL2000orEXCEL2003

Aベストアンサー

>Range("A:A", "E:E")
これは、A、B,C,D,E列のことなので
A列とE列であれば質問者のようにRange("A:A,E:E")です。

ま、それはそれとして、回答。

Sub Test()
 Range("A:A").Value = Range("A:A").Value
 Range("E:E").Value = Range("E:E").Value
End Sub

以上。
 


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング