Hücre Değerine Göre İşlem Yapma

[Akifff]

Merhaba arkadaşlar,

Konuyu açtığım yerden de anlaşılacağı üzere Excel VBA da ilk defa bişeyler yapmaya çalışıyorum. Bazı örnekler inceledim ve denemeler yaptım ama fonksyonlar ya hata veriyor ya sonsuz döngüye giriyor vs. İlk başlarda herkesin yaşadığı malum problemler.

Sorum şu şekilde örnekteki dosyada Durum hücresinin değeri "Beklemede" ise hiç birşey yapmasın ama diğer seçenekler seçilirse, aynı satırın "Gerçek" sütunundaki değeri önce tahmine geçirsin ve ardından silsin istiyorum. Tabi bu işlemi diğer hücreler içinde yapacağım eğer kısyol varsa daha iyi olur, yoksa tek tek kopyala yapıştır yaparız Resimle de anlatmaya çalıştım. Şimdiden teşekkürler..

Örnek Dosya
https://www.dropbox.com/s/2mcq9ha5s5uzm3e/Demo_Deneme.xlsm?dl=0

 

[calecale]

Merhabalar linkdeki örnek dosyayı inceler misiniz?

http://s2.dosya.tc/server3/k61yl3/Demo_Deneme.rar.html

 

[Akifff]

Hocam çok teşekkürler, yaptığınız kodlamayı inceledim, sistemde satır taraması yapınca birz donma yapıyordu şu şekilde değiştirmeye çalıştım nacizane:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sutun
Dim satir
Dim adr




adr = ActiveCell.Value
satir = ActiveCell.Row
sutun = ActiveCell.Column


If sutun = 5 And Cells(satir, "ı") <> "" Then

If adr <> "Beklemede" Then

Cells(satir, "g") = Cells(satir, "ı")
Cells(satir, "ı") = ""
End If
End If

End Sub

Yalnız şöyle bir sorunum var, ilgili hücreyi değiştirdiğimde, kodlar hemen çalışmıyor tekrardan mause ile veya tuşlarla o hücreye yeniden gidersem aktifleşiyor ve kodu uyguluyor. Bu durumda eğer hücreye geri dönmeden işlem yaparsam fiyatların yeri değişmemiş olacak. Bunu düzeltmenin bir yolu var mıdır. Saygılar.

http://dosya.co/gh9wgja0xhjm/Demo_Deneme_v2.xlsm.html

 

[PLİNT]

Merhaba
Kodlarınızı aşağıdaki gibi değiştirip denermisiniz?
http://s2.dosya.tc/server3/ckgcob/Demo_Deneme.zip.html

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "Beklemede" Then Exit Sub
If Not Intersect(Target, Range("E24:E41,E44:E61,E64:E80")) Is Nothing Then
Cells(Target.Row, 7) = Cells(Target.Row, 9)
 Cells(Target.Row, 9) = ""
 End If
If Not Intersect(Target, Range("Q24:Q41,Q44:Q61,Q64:Q68,Q71:Q74,Q77:Q80")) Is Nothing Then
Cells(Target.Row, 14) = Cells(Target.Row, 12)
 Cells(Target.Row, 12) = ""
 End If
End Sub

 

[Akifff]

Çok teşekkür ederim sayın hocam, işime yaradı.

Geç cevap verdiğim için kusura bakmayın. Saygılar.