半平太さんコメントありがとうございました。
■質問者さんのお気に召さないようですが、持っていても何の役にも立たないものですので、
事前に回答用に用意していたマクロ案(*)を提示して私の区切りとします。
閲覧者の参考になれば幸いです。
((*)見出しが2行になった点など簡単な修正は追加しました。）
・対象となる列は、make_dicプロシージャのなかに書き込んであります。（あくまで例示です）
dic("A") = "C"
dic("B") = "E"
dic("D") = "G"
は、 A列が変更されたらC列にもそれを反映するという設定を意味します。
次の二行も同様の意味合いです。（B列→E列, D列→G列 と言う意味です）
逆向きの流れ（C列が変更されたらA列に反映）は、
プログラム側で対応するので、設定は不要です。
これ以外にもペアの組があれば、追加して下さい。
■使い方
・該当のシートのシートモジュールに、提示したコードを一括してコピーして下さい。
・あとは、セルの変更をトリガーにして、値のコピーが自動的に行われます。
・なお、対象となる列のなかで複数セルを同時に変更する場合（複数セルをコピーペイストするとか、
複数セルを同時に消去する）にも、対応しています。
■イベントプロシージャは、それなりに落とし穴がある道具です。
提示したあとでもトラブルになりがちです。注意してください。
・列を挿入・削除したら動作がおかしくなりました、とか(対象列の定義の変更が必要となります）
・今まで自動で動いていたものが動かなくなった
(エラーが発生したときに、Application.EnableEvents が Falseになったままになっている）等々
■以下コードです。
Option Explicit
Dim dic As Object
Dim unionR As Range
'ペアとなる列の指定
Sub make_dic()
Dim e, v$
Set dic = CreateObject("Scripting.Dictionary")
dic("A") = "C" '■適宜修正が必要
dic("B") = "E" '■適宜修正が必要
dic("D") = "G" '■適宜修正が必要
For Each e In dic
v = dic(e)
dic(v) = e
Next
Debug.Print Now(); "created Dictionary "
End Sub
'イベント発生の対象となるセル範囲を設定
Function uRange() As Range
Dim s As String, key
For Each key In dic
s = s & key & "3:" & key & "150,"
Next
s = Left(s, Len(s) - 1)
Set uRange = Range(s)
Debug.Print Now(); "対象セル範囲設定済み,"; uRange.Address
End Function
'対象セル範囲の変更を、関連セル範囲に自動反映
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTarget As Range
Dim t As Range
Dim colname As String
If dic Is Nothing Then
make_dic
Set unionR = uRange()
End If
Set myTarget = Intersect(unionR, Target)
If myTarget Is Nothing Then Exit Sub
For Each t In myTarget
colname = Split(t.Address, "$")(1)
Application.EnableEvents = False
Cells(t.Row, dic(colname)) = t.Value
Application.EnableEvents = True
Next
End Sub
Sub 自動転記処理を再開()
Set dic = Nothing
Set unionR = Nothing
Application.EnableEvents = True
End Sub
■なお、ダブルクリックのイベントプロシージャを使えば、
・セルが""の状態であれば、"〇"を書き込み、
・セルに"〇"が入っていれば、"" で上書き
と、トグル方式で実行させることも可能でしょう。）
これも上記のコードと同じ、シートモジュールにコピーペイストします。
'ダブルクリックで、"〇"と""をトグル設定
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim colname As String
If dic Is Nothing Then
make_dic
Set unionR = uRange()
End If
If Intersect(unionR, Target) Is Nothing Then Exit Sub
colname = Split(Target.Address, "$")(1)
Cancel = True
Select Case Target.Value
Case "": Target.Value = "〇"
Case "〇": Target.Value = ""
End Select
End Sub
【補足】
(1)列の挿入、削除は実行しないで下さい。自動転記の対象列がズレます。
どうしても必要な場合は、
その場合は、次のような手順が間違いがないでしょう。
・ブックのバックアップを取っておきます。
・別の新しいシートに、記入済みのものをいったんコピー
・列の挿入、削除を実行。
・シートモジュールを、再作成したシートのシートモジュールにコピーペイスト
・再度、対象列の指定部分を修正する。
(2)また、ヘルパー関数として、下記のプロシージャが役に立つ時もあるかもしれません。
<<シートモジュール>>
Sub 自動転記処理を再開()
Set dic = Nothing
Set unionR = Nothing
Application.EnableEvents = True
End Sub
<<標準モジュール>>に
Sub 自動転記処理を中止する()
Application.EnableEvents = False
End Sub
'対象列を変更し、かつ同じシートを使い続ける場合は、これを実行します。
’これを実行しないと変更前のdic,対象セル範囲が継続して使われてしまいます。
Sub 自動転記処理を再開()
Call Sheet1.自動転記処理を再開 'sheet1での処理を再開する
End Sub
===========
総じて、ある程度マクロの取り扱いに慣れていないと、運用が難しいかもしれません。
前にも記載しましたが、
・入力列はどちから一方に限定し、
・関連する別の列ではそれを式で参照させ、その計算セルはロックを掛けて保護する
(その列には薄い灰色でも塗りつぶしておけばよいかもしれません。）
という方法が安全確実だと思います。
そう言う意味で上記マクロは参考情報です。
