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

Question

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

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

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

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

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

宜しくお願いします。

merlionXX · Accepted Answer

あらかじめ対照表を用意してあるのが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です。

merlionXX · Answer

ANo3, merlionXXです。

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

mu2011 · Answer

一例です。
シート１を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

pc_knight · Answer

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

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

okormazd · Answer

シート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))

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

あらかじめ対照表を用意してあるのがSheet1（もしちがっていらた下記のコードの"Sheet1"を修正してください。

ANo3, merlionXXです。

一例です。

シート「シート２」のシート名タグを右クリック→コードの表示（Ｖ）で表示されるコードエリアに以下のコード貼り付けたらで自動的にできます。

シート1のA1:B1から、部品名、英訳の一覧があるとする。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング