Hücre Atlama Sorunu

[igultekin2000]

Merhaba;
D2 hücresinde TRANSFER yazdığında G2 hücresinden J2 hücresine atlamasını istiyorum. Yazdığım doğru olmasına rağmen işlem yapmıyor, sorunu çözemedim. Teşekkürler

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 On Error Resume Next
Static EskiHucre As Range
  If Target.Interior.ColorIndex <> xlColorIndexNone Then
    EskiHucre.Interior.ColorIndex = xlColorIndexNone
    Exit Sub
  ElseIf Not EskiHucre Is Nothing Then
    EskiHucre.Interior.ColorIndex = xlColorIndexNone
  End If
  Target.Interior.ColorIndex = 7
  Set EskiHucre = Target

If Target.Address(0, 0) = "I2" And [D2] = "DÜŞÜM" Then [J2].Activate

If Target.Address(0, 0) = "E2" And [D2] = "İTHALAT" Then [G2].Activate
If Target.Address(0, 0) = "J2" And [D2] = "İTHALAT" Then [L2].Activate
If Target.Address(0, 0) = "I2" And [D2] = "İTHALAT" Then [J2].Activate


If Target.Address(0, 0) = "H2" And [D2] = "TRANSFER" Then [J2].Activate

If Target.Address(0, 0) = "L2" And [D2] = "TRANSFER" Then [N2].Activate
If Target.Address(0, 0) = "G2" And [D2] = "TRANSFER" Then [J2].Activate

If Intersect(Target, Range("O1:O2")) Is Nothing Then Exit Sub
'islem_kayit
End Sub

 

[Mahmut Kök]

Yazdığınız If Target.Interior.ColorIndex <> xlColorIndexNone Then satırı dolayısıyla istediğiniz işlem tamamlanmıyor. 2. satırı komple seçip hücre dolgusunu temizlerseniz sorun düzelir. Zemin renginin boş olması gerekiyor.

 

[igultekin2000]

Teşekkür ederim, ilgili satır ve ona bağlı satırları tamamen sildiğimde sorun ortadan kalkıyor. Ancak seçili hücrenin belirgin olması için farklı bir uygulama var mıdır? Zaman içinde bulmak dileğiyle, iyi çalışmalar.

 

[YUSUF44]

Ordaki Exit sub satırı kodun sonlanmasını sağlıyor. Kodun sonlanmasını gerektirecek bir durum göremedim. Eğer gerekli değilse o satırı iptal edebilirsiniz ya da exit sub yerine Goto 10 deyip hücre atlama satırlarından önce de 10: diyerek o kısma geçmesini sağlayabilirsiniz:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 On Error Resume Next
Static EskiHucre As Range
  If Target.Interior.ColorIndex <> xlColorIndexNone Then
    EskiHucre.Interior.ColorIndex = xlColorIndexNone
    GoTo 10
  ElseIf Not EskiHucre Is Nothing Then
    EskiHucre.Interior.ColorIndex = xlColorIndexNone
  End If
  Target.Interior.ColorIndex = 7
  Set EskiHucre = Target
10:
If Target.Address(0, 0) = "I2" And [D2] = "DÜŞÜM" Then [J2].Activate

If Target.Address(0, 0) = "E2" And [D2] = "İTHALAT" Then [G2].Activate
If Target.Address(0, 0) = "J2" And [D2] = "İTHALAT" Then [L2].Activate
If Target.Address(0, 0) = "I2" And [D2] = "İTHALAT" Then [J2].Activate


If Target.Address(0, 0) = "H2" And [D2] = "TRANSFER" Then [J2].Activate

If Target.Address(0, 0) = "L2" And [D2] = "TRANSFER" Then [N2].Activate
If Target.Address(0, 0) = "G2" And [D2] = "TRANSFER" Then [J2].Activate

If Intersect(Target, Range("O1:O2")) Is Nothing Then Exit Sub
'islem_kayit
End Sub

 

[igultekin2000]

Teşekkür ederim, sizin yazdığınız şekilde sorunsuz renklendirme de çalışıyor. İyi çalışmalar.