| 
    
     |  | ▼ぶんぶん さん: 
 Workbook_SheetChange のみ以下と入れ替えて試してみてください。
 
 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 Dim myR As Range
 
 If Not Sh Is Sheets(shn) Then Exit Sub
 Set myR = Union(Sh.Range("選択その1"), Sh.Range("選択その2"), Sh.Range("選択その3"), Sh.Range("選択その4"))
 If Intersect(Target, myR) Is Nothing Then Exit Sub
 If WorksheetFunction.CountA(myR) = 4 Then
 Sh.Range("選択その1").Activate
 Exit Sub
 End If
 Select Case Target.Address
 Case Sh.Range("選択その1").Address
 ListShow Sh.Range("選択その2")
 Case Sh.Range("選択その2").Address
 ListShow Sh.Range("選択その3")
 Case Sh.Range("選択その3").Address
 ListShow Sh.Range("選択その4")
 Case Sh.Range("選択その4").Address
 ListShow Sh.Range("選択その1")
 End Select
 End Sub
 
 |  |