[[20200409181202]]　『別々のセル間のデータを常に双方向で同期する方法』（ずー）　ページの最後に飛ぶ

『別々のセル間のデータを常に双方向で同期する方法』（ずー）

Sheet1　A1に1と入れると、Sheet2　B1とSheet3　C1に同期して同じ数値を入れる以下プログラムがあるのですが、１つのセルの同期から範囲の同期をさせるのはどのようにすればよいですか？教えてください（＞＜）

Sheet1のA1→A1からA10の範囲へ
Sheet2のB1→B1からB10の範囲へ
Sheet3のC1→C1からC10の範囲へ

'Sheet1のモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)

 Dim rng As Variant
 Dim ws As Variant
 Dim i As Integer
 Application.EnableEvents = False
 If Target.Address(0, 0) <> "A1" Then Exit Sub
 ws = Array("Sheet2", "Sheet3")
 rng = Array("B1", "C1")
 For i = 0 To 1
 Worksheets(ws(i)).Range(rng(i)).Value = Target.Value
 Next i
 Application.EnableEvents = True
 End Sub

 'Sheet2のモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rng As Variant
 Dim ws As Variant
 Dim i As Integer
 Application.EnableEvents = False
 If Target.Address(0, 0) <> "B1" Then Exit Sub
 ws = Array("Sheet1", "Sheet3")
 rng = Array("A1", "C1")
 For i = 0 To 1
 Worksheets(ws(i)).Range(rng(i)).Value = Target.Value
 Next i
 Application.EnableEvents = True
 End Sub

 'Sheet3のモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rng As Variant
 Dim ws As Variant
 Dim i As Integer
 Application.EnableEvents = False
 If Target.Address(0, 0) <> "C1" Then Exit Sub
 ws = Array("Sheet1", "Sheet2")
 rng = Array("A1", "B1")
 For i = 0 To 1
 Worksheets(ws(i)).Range(rng(i)).Value = Target.Value
 Next i
 Application.EnableEvents = True
 End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

 こういうことですか？

 Private Sub Worksheet_Change(ByVal Target As Range)
     Dim rng As Range
     Dim ws As Variant
     Dim i As Long
     Dim myCol As Variant
     Dim r As Range

     Set rng = Intersect(Target, Range("A1:A10"))
     If rng Is Nothing Then Exit Sub

     Application.EnableEvents = False
     ws = Array("Sheet2", "Sheet3")
     myCol = Array(2, 3)
     For Each r In rng
         For i = 0 To 1
             Worksheets(ws(i)).Cells(r.Row, myCol(i)).Value = r.Value
         Next
     Next
     Application.EnableEvents = True
 End Sub

（γ） 2020/04/09(木) 19:27

提示されたコードについてのコメントですが、
Application.EnableEvents = False
の位置が悪いです。
対象外の範囲の時、常に Falseになってしまいます。
（γ） 2020/04/09(木) 19:30

'Sheet1のモジュールの場合

Private Sub Worksheet_Change(ByVal Target As Range)

    Set Target = Intersect(Target, Me.Range("A1:A10"))
    If Target Is Nothing Then Exit Sub

    Application.EnableEvents = False
    With Target
        Worksheets("Sheet2").Range(.Offset(, 1).Address).Value = .Value
        Worksheets("Sheet3").Range(.Offset(, 2).Address).Value = .Value
    End With
    Application.EnableEvents = True
End Sub

2つだしあえてループを書かなくてもよくないですか？
（まっつわん） 2020/04/09(木) 20:20

有難う御座います。
シート２およびシート３に入力した際にも、数値が変更できるようにしたいのですが。
どのようにすればよいのでしょうか。

（ずー） 2020/04/10(金) 09:35

Worksheets("Sheet2").Range(.Offset(, 1).Address).Value = .Value
Worksheets("Sheet3").Range(.Offset(, 2).Address).Value = .Value
この部分をいじり、各シートに入力するとできました。有難うございました。
（ずー） 2020/04/10(金) 09:59

コメント返信：

[ 一覧(最新更新順) ]

[[20200409181202]] 『別々のセル間のデータを常に双方向で同期する方法』（ずー） ページの最後に飛ぶ

[[20200409181202]]　『別々のセル間のデータを常に双方向で同期する方法』（ずー）　ページの最後に飛ぶ