転記の簡素化とワークシートプロシージャの制御

Question

起こっている現象は、画像を更に追加しましたが、1列なら、そのまま数値を追記していってくれるのですが、
2行になると、なぜか、最後尾の５が分身してしまいます、、
教えていただいたとおりに、Ｔａｒｇｅｔを使ってみてると、いきなりは、分身しなくなりましたが、やはりある回数以上になると、こういう分身が起こります、、なぜでしょうか、、

画像説明
下段の画像のワークシートに構文をworksheet_changeにて作っております。←計算表シート
その数値を上段のシートに転記しています。←出目回数シート
いつもお世話になっております。
worksheet change にて、以下の構文を回すと、数値の変化に合わせて、他の列も同時に転記してしまうという状況の解決方法で困っています。
数値が変化した個所のみを列に追記していくようにしたいのですが、selectionchangeにしても標準モジュールにして治りません、
また、今の自分ではこれ以上の簡素化することはできないですが、こういう複数分岐する場合にどのように簡素化できるのか、方法ってあるのでしょうか？もし差し支えなければご教授いただければ幸いです。

数値の変化とは、右辺のセルの数値が常に変化しており、その数値を左辺に転記しているのですが、他のセルの数値の一つにでも変化がああれば、左辺にすべての右辺が代入されるという状況です。。

Private Sub Worksheet_Change(ByVal Target As Range)

Const maxcolumn = 39
'
'Dim j As Long
'Dim n As Long
'Dim t As Long
'Dim lastrow As Long
'
'With Worksheets("出目回数")
'    For j = 2 To maxcolumn
'    lastrow = .Cells(Rows.Count, j).End(xlUp).Row
'    n = lastrow + 1
'   If j = 3 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("D9").Value '1
'   If j = 4 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("D6").Value '2
'   If j = 5 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("D3").Value '3
'   If j = 6 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("E9").Value '4
'   If j = 7 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("E6").Value '5
'   If j = 8 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("E3").Value '6
'   If j = 9 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("F9").Value '7
'   If j = 10 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("F6").Value '8
'   If j = 11 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("F3").Value '9
'   If j = 12 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("G9").Value '10
'   If j = 13 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("G6").Value '11
'   If j = 14 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("G3").Value '12
'   If j = 15 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("H9").Value '13
'   If j = 16 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("H6").Value '14
'   If j = 17 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("H3").Value '15
'    If j = 18 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("I9").Value '16
'    If j = 19 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("I6").Value '17
'    If j = 20 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("I3").Value '18
'    If j = 21 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("J9").Value '19
'    If j = 22 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("J6").Value '20
'    If j = 23 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("J3").Value '21
'    If j = 24 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("K9").Value '22
'    If j = 25 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("K6").Value '23
'    If j = 26 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("K3").Value '24
'    If j = 27 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("L9").Value '25
'    If j = 28 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("L6").Value '26
'    If j = 29 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("L3").Value '27
'    If j = 30 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("M9").Value '28
'    If j = 31 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("M6").Value '29
'    If j = 32 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("M3").Value '30
'    If j = 33 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("N9").Value '31
'    If j = 34 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("N6").Value '32
'    If j = 35 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("N3").Value '33
'    If j = 36 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("O9").Value '34
'    If j = 37 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("O6").Value '35
'    If j = 38 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("O3").Value '36
'    If j = 39 Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("B3").Value '0
  
  
'Next
'End With



![![イメージ説明](c171146cfabedf143323ca7297da886f.png)](cea8886a94d901e16163401274982853.png)
コード

Comments

[meg_]

仕様がよく分からないので、シートイメージを画像で追加してもらえませんか？

[kohan]

はい。では、イメージ画像を追加いたしますね。

[meg_]

・どっちの画像がどっちのシートですか？
・Worksheet_Change()はどっちのシートに設定してあるんですか？

[kohan]

失礼いたしました。説明補足いたします。

[meg_]

Private Sub Worksheet_Change(ByVal Target As Range)
の「Target」が値が変わったセルとなります。
> 数値が変化した個所のみを列に追記していくようにしたい
とのことなので、この「Target」セルの値（Target.Value）を転記すれば所望の動作になるのではないでしょうか？

[kohan]

具体的な例としては、以下のように修正すれば数値が変化した個所のみを転記するということで解釈は間違っていませんか？
If j = 3 And Target=Worksheets("計算表").Range("D9").Value Then Worksheets("出目回数").Cells(n, j) = Worksheets("計算表").Range("D9").Value

[meg_]

Worksheets("計算表").Range("D9")の値が変わったときに、このセルの値をどこにコピーしたいのですか？

[kohan]

Worksheets("出目回数").Cells(n, j) でIf j = 3 なので、3列目の最後尾にコピーしたいです。

Answer 1

下記は「D9」セルの例です。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$D$9" Then
        With Worksheets("出目回数")
            .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 3).Value = Target.Value
        End With
    End If

End Sub

また、今の自分ではこれ以上の簡素化することはできないですが、こういう複数分岐する場合にどのように簡素化できるのか、方法ってあるのでしょうか？

これについては転記元のアドレスから転記先のアドレスが計算で決まれば簡潔に記述することはできますが、関連がなくバラバラであれば出来ないでしょう。

Comments

[kohan]

すごいですね。。。。脱帽です、、よろしければ、解法（式の立て方）を教えてくださいませんか？

Answer 2

また、今の自分ではこれ以上の簡素化することはできないですが、こういう複数分岐する場合にどのように簡素化できるのか、方法ってあるのでしょうか？

今回の場合ですと、Targetの情報より、jの値を以下のように計算できます。

    r = Target.Row
    c = Target.Column
    
    j = (c - 3) * 3 + 3 - r / 3

ですので、Ifの連続のところは

    r = Target.Row
    c = Target.Column
    
    j = (c - 3) * 3 + 3 - r / 3

　　Worksheets("出目回数").Cells(n, j) = Target.Value

のように簡略化できますね。