• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kod hatası

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [L6:L150]) Is Nothing Then
On Error Resume Next
If Target.Value <= 10 Then Target.Offset(0, 7).Value = Target.Offset(0, -1).Value + (Target.Value * Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value)
ElseIf Not Intersect(Target, [L6:L150]) Is Nothing Then
If Target.Value > 10 Then Target.Offset(0, 7).Value = Target.Offset(0, -1).Value + (Target.Value * Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value) + [(Target.Value-10)*Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value)*0.5]
End If
End Sub
Üstadlarım kodda hata yaptım.
Birinci koşul çalışmakta ama ikinci koşul işlem görmemekte
Yardımcı olabilir misiniz?
 
Merhaba,

Aradaki "ElseIf" ile başlayan satırı ve sondaki "End If" satırını silerek deneyin.

Birde "On Error Resume Next" satırını "Private" ile başlayan satırın altına yazın.

Bu satırı;
Kod:
If Not Intersect(Target, [L6:L150]) Is Nothing Then

Bununla değiştirin;
Kod:
If Intersect(Target, [L6:L150]) Is Nothing Then Exit Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [L6:L150]) Is Nothing Then
If Target.Value <= 10 Then Target.Offset(0, 7).Value = Target.Offset(0, -1).Value + (Target.Value * Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value)
If Intersect(Target, [L6:L150]) Is Nothing Then Exit Sub
If Target.Value > 10 Then Target.Offset(0, 7).Value = Target.Offset(0, -1).Value + (Target.Value * Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value) + [(Target.Value-10)*Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value)*0.5]
End If
End Sub


Korhan Uzmanım Yanlış yapmadı isem yine çalışmadı
 
Merhaba,

Yanlış yapmışsınız. Mesajımı iyi okuyun.
 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [L6:L150]) Is Nothing Then Exit Sub
If Target.Value <= 10 Then Target.Offset(0, 7).Value = Target.Offset(0, -1).Value + (Target.Value * Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value)
If Target.Value > 10 Then Target.Offset(0, 7).Value = Target.Offset(0, -1).Value + (Target.Value * Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value) + [(Target.Value-10)*Target.Offset(0, 3).Value * Target.Offset(0, 4).Value * Target.Offset(0, 5).Value)*0.5]
End Sub

Korhan Abi bu da yanlış ise;
Cahilliğime mahsuben doğru kodu siz verin ne olur.
Bu kodda birinci koşulu sağlıyor ikinci koşula gelince yani 10 rakamından yukarısına gelince çalışmıyor.
 
Merhaba,

Son verdiğiniz yazım doğru. Ben sadece kodun yazım şeklini kontrol ettim. Sonuç üretmiyorsa dosyanızı incelemek gerekir. Demekki eksik bir şey var kodunuzda. Dosyanızı ekleyin inceleyelim.
 
Korhan Uzmanım;
L6 hücresi 11 olunca S6 Hücresi 62,45
L6 hücresi 12 olunca S6 Hücresi 64,09
L6 hücresi 13 olunca S6 Hücresi 65,74
L6 hücresi 14 olunca S6 Hücresi 67,38
L6 hücresi 15 olunca S6 Hücresi 69,03
L6 hücresi 20 olunca S6 Hücresi 77,25
L6 hücresi 30 olunca S6 Hücresi 93,70 örnekleri ile kontrolunu teyit edebilirsiniz?

İlginiz için teşekkür ederim
 

Ekli dosyalar

Merhaba,

Değer değişince uygulamak istediğiniz formülüde yazar mısınız?
 
Korhan Uzmanım Bakanlığın belirlediği formül
10 km’ye kadar olanlar için aşağıdaki formül uygulanır.

Muhammen bedel= Taban Katsayısı+(Mesafe x MF x YK x AK)

10 km’den fazla olması halinde aşağıdaki formül uygulanır.

Muhammen bedel= Taban Kat Sayısı+ (Mesafe x MF x YK x AK) + [ (Mesafe-10) x MF x YK x AK x 0,5 ]
MF= Mazot fiyatı
YK= Yol Katsayısı
AK= Araç Katsayısı
değişme durumu ise özellikle mesafe ya da yol durumunda gerçekleşmekte.
 
Merhaba,

Eklediğiniz dosyadaki 6. satıra aşağıdaki formülü uyguluyorum ve kırmızı renkli sonucu elde ediyorum.

Kod:
=K6+(L6*O6*P6*Q6)+((L6-10)*O6*P6*Q6*0,5)

70,67

Siz ise bu değerin 62,45 olması gerektiğini belirtmişsiniz.

Acaba formül kurgusunda hatamı yaptım.
 
Merhaba,

Tamam ben olayı çözdüm. Aşağıdaki kodu deneyin. Hesaplamayı etkileyecek tüm hücrelerin değişiminde kod çalışır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Satır As Long, Formül As String
    On Error GoTo Son
    If Intersect(Target, Range("K6:Q" & Rows.Count)) Is Nothing Then Exit Sub
    Satır = Target.Row
    Formül = "=IF(L6<=10,K6+(L6*O6*P6*Q6),K6+(10*O6*P6*Q6)+((L6-10)*O6*P6*Q6*0.5))"
    Formül = Replace(Formül, 6, Satır)
    Application.EnableEvents = False
    Cells(Satır, "S") = Evaluate(Formül)
Son:
    Application.EnableEvents = True
End Sub
 
Korhan Abi
Eline Koluna Sağlık
ALLAH Ne Muradın varsa versin
Zahmet verdiysem kusura bakma abi.
 
Korhan abi
edepsizlik olmazsa
koda
taşıma gün sayısı * günlük fiyat sonucunu yıllık fiyata yazabilmesi içi ekleme yapılmasını istirham edebilir miyim?
 
Merhaba,

"Son:" yazısından önceki satıra aşağıdaki kodu yazın.

Kod:
    Cells(Satır, "T") = Cells(Satır, "R") * Cells(Satır, "S")
 
Korhan Uzmanım;
Sorularıma sabır gösterip yardımlarınızı esirgemediğiniz için
Şahsınıza sonsuz teşekkürlerimi sunarım.
Hakkınızı helal ediniz.
 
Geri
Üst