EXCELで入力した文字を自動的に置換させたいです

質問

会社の仕事で、部品リストを会社で決められた英訳に従って翻訳しなければならず困っています；
会社で決められた英訳単語数は３５０単語あり、ＥＸＣＥＬで一覧として与えられました。

そこで、ＥＸＣＥＬで自動翻訳させるマクロを教えてくださいm(_ _)m

予め「シート１」のＡ列に（部品名）、Ｂ列に（決められた英訳）を入力しておき。

「シート２」のＡ列またはＣ列に部品名が入力されると、それぞれＢ列・Ｄ列に自動で自分の決めた訳に置換させる方法を教えてほしいです。

（例）
　「シート１」　　　　　　　　　　　　　　　　　　　　　　　「シート２」
　　｜　　Ａ　　｜　　Ｂ　　｜　　　　　　　　　　　　　｜　　Ａ　　｜　　Ｂ　　｜　　Ｃ　　｜　　Ｄ　　｜
１　　　　釦　　　 SWITCH　　　　　　　　　　　　　１　　ヒューズ　　FUSE　　　ランプ　　　LAMP
２　　　ランプ　　　LAMP　　　　　　　　　　　　　　２　　ランプ　　　LAMP　　ヒューズ　　FUSE
３　　ヒューズ　　　FUSE　　　　　　　　　　　　　　３　　　釦　　　SWITCH　　ヒューズ　　FUSE

宜しくお願いします。

回答No.3

merlionXX · ベストアンサー

あらかじめ対照表を用意してあるのがSheet1（もしちがっていらた下記のコードの"Sheet1"を修正してください。）
Ａ列またはＣ列に部品名を入力するのがSheet2だとします。

1. シート（Sheet2）のタブを右クリックして、[コードの表示]。
2. 出てきた白い所に、以下のコードを貼付けます。

'********これより下**********

Private Sub Worksheet_Change(ByVal Target As Range)
　　If Target.Column <> 1 And Target.Column <> 3 Then Exit Sub
　　Dim myDic As Object
　　Dim myW
　　Dim i As Long, c As Range
　　Set myDic = CreateObject("Scripting.Dictionary")
　　With Sheets("Sheet1")
　　　　myW = .Range("A1", .Cells(Rows.Count, "B").End(xlUp)).Value
　　End With
　　For i = 1 To UBound(myW)
　　　　myDic(myW(i, 1)) = myW(i, 2)
　　Next i
　　For Each c In Target
　　If myDic.Exists(c.Value) Then
　　　　c.Offset(, 1).Value = myDic(c.Value)
　　End If
　　Next c
End Sub

'********これより上**********

3.Alt+F11キーでワークシートへもどります。

これでOK
A、C列以外への入力には反応しません。
Sheet1の対照表は何百行あってもOKです。

お礼

インターネットの調子が悪く、回答が遅れてすみません＞＜
初日は私の知識不足で理解するまでに時間がかかってしまったのも事実なので
本当に申し訳ないです。

こちらのマクロは私の要望を全てかなえてくれました。
しかも、こちらは貼り付けるだけでそのまま使えました。
EXCELテクニック集という感じで、こういう使い方ができるんだと感動しました。

本当にありがとうございました。迷うことなくベストアンサーです。

回答No.5

merlionXX

ANo3, merlionXXです。

No2のお礼に
「このシートに作る方法だとコピー＆ペーストで変換されないようなので、時間があったらボタンを作って実行型のマクロを作ってみようかと思います。」
とお書きですが、わたしのコード（ANo3）ではA列とC列は、複数セルへのコピー＆ペーストでも大丈夫なように書いてありなす。
まだおためしにはなってないのでしょうか？

お礼

回答が遅くなってしまい申し訳ありませんでした。
会社のインターネット環境が悪く、ベストアンサーの画面に到達できず。
「参考になった」のボタンがやっとでした（汗
今回を機に自宅にもインターネットを引くことにしました。

早期回答に対し、お礼も遅く、回答していただいた皆様にはご迷惑をお掛けしましたm(_ _)m
本当にありがとうございました。

回答No.4

mu2011

一例です。
シート１をSheet1、シート２をSheet2としています。
（１）Sheet2のシートタブ上で右クリック→コードの表示→以下のコードを貼り付けてシート２のＡ，Ｃ列に入力してみて下さい。
　　　必要ないと思いますが複数セルへの入力も可能としています。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing _
And Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
For Each c In Sheets("Sheet1").Range("A:A")
If c.Value = "" Then Exit Sub
For Each d In Range(Target.Address)
If c.Value = d.Value Then
d.Offset(0, 1).Value = c.Offset(0, 1).Value
End If
Next
Next
End Sub

お礼

回答ありがとうございます。

こちらの方法でも問題なく変換されました。
ベストアンサーが複数選べたらこちらにも付けたかったです。

貴重な回答ありがとうございました。

回答No.2

pc_knight

シート「シート２」のシート名タグを右クリック→コードの表示（Ｖ）で表示されるコードエリアに以下のコード貼り付けたらで自動的にできます。
下記コード中、「"シート１"」は予め英訳を載せてあるシートのシート名です。シート名が合致していないと「シート２」へのインプット中にエラーが起きます。その場合は、シート名がコードに一致するよう訂正して下さい。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Double
If Target.Count = 1 And Target.Column = 1 Then
If Target.Value <> "" Then
For r = 1 To Sheets("シート１").Range("A65536").End(xlUp).Row
If Sheets("シート１").Cells(r, 1) = Target.Value Then
ActiveCell.Offset(-1, 1).Value = Sheets("シート１").Cells(r, 2) '英訳品名自動記入
Exit Sub
End If
Next r
Else
ActiveCell.Offset(0, 1).ClearContents 'A列データ消去の時B列データも消去
Exit Sub
End If
End If
End Sub

お礼

要望通りマクロでの回答ありがとうございます。
会社のエクセルでセルに数式を入れていると、使用者に操作されたときに消されてしまうので
こちらの方法に変更させていただきました。

会社で使っているEXCELは2007なのですが、5行目の
For r = 1 To Sheets("シート１").Range("A65536").End(xlUp).Row
が「複雑すぎて実行できません」とエラーが出てしまったので、とりあえず
For r = 1 To 1000
として使用させて頂いています。
本当は上記の方法の方が下方検索として使い勝手は良かったので残念です。

それと、このシートに作る方法だとコピー＆ペーストで変換されないようなので、
時間があったらボタンを作って実行型のマクロを作ってみようかと思います。
この度はありがとうございました。

回答No.1

okormazd

シート1のA1:B1から、部品名、英訳の一覧があるとする。
シート２のB1、D1に下記の式を入れて下にフィルする。

B1
=IF(A1="","",VLOOKUP(A1,Sheet1!$A$1:$B$3,2,FALSE))
D1
=IF(A1="","",VLOOKUP(C1,Sheet1!$A$1:$B$3,2,FALSE))

お礼

回答ありがとうございます。
インターネットの調子が悪くて返信が遅くなり申し訳ありません。

マクロを使わなくてもこの方法で英訳を行うことができました。
会社の作業員によって半角/全角がマチマチで全角に統一させてから行うことで
問題なく行うことが出来ました。
他に使っているデータにも流用できそうなので、使わせていただきます。