私は広範な問題追跡ファイルのためのVBA設定に取り組んでいます。私はすべての問題を含む1枚のシートを持っています、そして管理するのは難しいです。ある日の優先順位の高い10個の項目をユーザーに提示し、それらの項目を更新してさらに問題を取り出せるように設計された別のシートがあります。データがミラー化されている方法のため、ユーザーはどちらかのシート上のデータを操作し、それをもう一方のシートにミラーリングできるようにする必要があります。
別の質問からいくつかの提案されたコードを見つけ、1つのセルしかミラーリングしていない限りそれを機能させることができましたが、他のセルに追加するコードの複製を開始するとすぐに（約200のセルが必要です） （ミラーリングされている）、すべてのセルは更新を停止します（以前は正常に機能していたものも含む）。
の その他の問題 追加のセルミラーリングコード行を追加する前でも、シートが最も優先度の高い10項目をレポートする方法に関連していました。私は最初のシート（わかりにくいもの）を取り、特定の方法でデータをソートするマクロを作成し、そのマクロをもう一方のページのボタンに添付しました。ボタンを押すと、最初のシートのデータが正しくソートされますが、ミラーリングされたセルは更新されません。だから私は知る必要があります 1） 複数のセルをミラーリングできるようにコードを調整する方法 2） ボタンを使って最初のシートをソートすると、2番目のシートのデータが更新されます。
ミラー化セルを1セットしか持っていないときに機能していたコードは、シート1コードにある以下のコードです。
Private Sub Worksheet_Change_B2(ByVal Target As Range)
Dim B2 As Range, B2_1 As Range
Set B2 = Range("B2")
Set B2_1 = Sheets("Priority Table").Range("B2")
If Intersect(Target, B2) Is Nothing Then Exit Sub
Application.EnableEvents = False
B2_1.Value = B2.Value
Application.EnableEvents = True
End Sub
そして、次はシート2コードにあります。
Private Sub Worksheet_Change_B2(ByVal Target As Range)
Dim B2 As Range, B2_1 As Range
Set B2 = Range("B2")
Set B2_1 = Sheets("Issue List").Range("B2")
If Intersect(Target, B2) Is Nothing Then Exit Sub
Application.EnableEvents = False
B2_1.Value = B2.Value
Application.EnableEvents = True
End Sub
私が現在シート1に持っているものは、（私はすべての200+の代わりに3つの参照セルを含みます）です。
Private Sub Worksheet_Change_B2(ByVal Target As Range)
Dim B2 As Range, B2_1 As Range
Set B2 = Range("B2")
Set B2_1 = Sheets("Priority Table").Range("B2")
If Intersect(Target, B2) Is Nothing Then Exit Sub
Application.EnableEvents = False
B2_1.Value = B2.Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change_I2(ByVal Target As Range)
Dim I2 As Range, I2_1 As Range
Set I2 = Range("I2")
Set I2_1 = Sheets("Priority Table").Range("B3")
If Intersect(Target, I2) Is Nothing Then Exit Sub
Application.EnableEvents = False
I2_1.Value = I2.Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change_P2_1(ByVal Target As Range)
Dim P2 As Range, P2_1 As Range
Set P2 = Range("P2")
Set P2_1 = Sheets("Priority Table").Range("B4")
If Intersect(Target, P2) Is Nothing Then Exit Sub
Application.EnableEvents = False
P2_1.Value = P2.Value
Application.EnableEvents = True
End Sub
また、シート2のマッチングコードは次のとおりです。
Private Sub Worksheet_Change_B2(ByVal Target As Range)
Dim B2 As Range, B2_1 As Range
Set B2 = Range("B2")
Set B2_1 = Sheets("Issue List").Range("B2")
If Intersect(Target, B2) Is Nothing Then Exit Sub
Application.EnableEvents = False
B2_1.Value = B2.Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change_B3(ByVal Target As Range)
Dim B3 As Range, B3_1 As Range
Set B3 = Range("B3")
Set B3_1 = Sheets("Issue List").Range("I2")
If Intersect(Target, B3) Is Nothing Then Exit Sub
Application.EnableEvents = False
B3_1.Value = B3.Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change_B4(ByVal Target As Range)
Dim B4 As Range, B4_1 As Range
Set B4 = Range("B4")
Set B4_1 = Sheets("Issue List").Range("P2")
If Intersect(Target, B4) Is Nothing Then Exit Sub
Application.EnableEvents = False
B4_1.Value = B4.Value
Application.EnableEvents = True
End Sub
これらの問題の両方のための任意の助けは大歓迎です！
前もって感謝します
Exit Subあなたのチェックが失敗したとき。これにより、ほとんどすべてのコードがバイパスされます。代わりに確認してくださいIf Not (Intersect(Target, "B2") Is Nothing) Then適切にEnd If。