HÜCRE BOŞ İSE MAKRO DEVREYE GİRSİN

[cocoa35]

Merhaba Arkadaşlar; Ek'te örnek dosyada belirtmiş olduğum bir makroya ihtiyacım var. Şöyleki; Örnek dosyada belirtildiği şekilde örneğin, G3 Hücresi boş ise ( EĞER(B8=1;6,5;3,5 ) Yani B8 Hücresinde 1 yazıyorsa G3 'e 6,5 yoksa 3,5 yazsın . Eğer G3 Hücresi dolu ise makro çalışmasın.
Şimdiden teşekkürler.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu ilgili sayfanın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G3")) Is Nothing Or Range("G3") <> "" Then
    Exit Sub
Else
    Application.EnableEvents = False
    Range("G3").FormulaLocal = "=EĞER(B8=1;6,5;3,5)"
    Application.EnableEvents = True
End If
End Sub

 

[cocoa35]

Çok teşekkürler gayet iyi olmuş çalıştırdım.

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...

 

[cocoa35]

Rica ederim,
İyi çalışmalar...

Ömer bey iyi akşamlar; Yukardaki kod'lar bir hücrede değişiklik olduğunda gayet iyi işliyor ancak aynı sayfada benim 4 hücrede bu şekilde işlem yapmam gerekiyor , ben sizin kod'ları buna göre ayarladım ancak sadece bir hücre çalışıyor ( oda sonuncu olan) diğerleri çalışmıyor. Mutlaka benim kod'larda yanlışlık var bir kontrol edebilirmisiniz lütfen. Benim kod'lar şöyle

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G47")) Is Nothing Or Range("G47") <> "" Then
If Intersect(Target, Range("G57")) Is Nothing Or Range("G57") <> "" Then
If Intersect(Target, Range("G58")) Is Nothing Or Range("G58") <> "" Then
If Intersect(Target, Range("G67")) Is Nothing Or Range("G67") <> "" Then
Exit Sub
Else
Application.EnableEvents = False
Range("G47").FormulaLocal = "=EĞER(B50=1;1,22;5,5)"
Range("G57").FormulaLocal = "=KOD!L221/KOD!I219"
Range("G58").FormulaLocal = "=(((G57*1,39)*0,205)+((G57*1,39)*0,02)+((G57*1,39)*0,15)+((G57*1,39)*0,00759))"
Range("G67").FormulaLocal = "=B67*0,015*0,70"
Application.EnableEvents = True
End If
End If
End If
End If
End Sub

 

[ÖmerBey]

İyi akşamlar sayın cocoa35,
Aşağıdaki kodları deneyiniz...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G47,G57,G58,G67")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Range("G47") = "" Then Range("G47").FormulaLocal = "=EĞER(B50=1;1,22;5,5)"
If Range("G57") = "" Then Range("G57").FormulaLocal = "=KOD!L221/KOD!I219"
If Range("G58") = "" Then Range("G58").FormulaLocal = "=(((G57*1,39)*0,205)+((G57*1,39)*0,02)+((G57*1,39)*0,15)+((G57*1,39)*0,00759))"
If Range("G67") = "" Then Range("G67").FormulaLocal = "=B67*0,015*0,70"
Application.EnableEvents = True
End Sub

 

[cocoa35]

Çok teşekkürler ömer bey Gayet güzel çalışıyor.