• DİKKAT

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

Çözüldü Eğerli makro

sirkülasyon

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G6:G250,I6:S250")) Is Nothing Then Exit Sub
    If UCase(Cells(Target.Row, "G")) = "KDV'li" Then
        Cells(Target.Row, "K") = Round(Cells(Target.Row, "I") * Cells(Target.Row, "J"), 2)
        Cells(Target.Row, "L") = Round(Cells(Target.Row, "K") * 8 / 100, 2)
        Cells(Target.Row, "M") = Round(Cells(Target.Row, "K") + Cells(Target.Row, "L"), 2)
        Cells(Target.Row, "N") = Round(Cells(Target.Row, "L") / 2, 2)
        Cells(Target.Row, "O") = Round(Cells(Target.Row, "K") * 0.00948, 2)
        Cells(Target.Row, "T") = Round(Cells(Target.Row, "L") + Cells(Target.Row, "M") + Cells(Target.Row, "N") + Cells(Target.Row, "O") + Cells(Target.Row, "P") + Cells(Target.Row, "Q") + Cells(Target.Row, "R") + Cells(Target.Row, "S"), 2)
        Cells(Target.Row, "U") = Round(Cells(Target.Row, "K") - Cells(Target.Row, "T"), 2)
        
    ElseIf UCase(Cells(Target.Row, "G")) = "KDV'SİZ" Then
        Cells(Target.Row, "K") = Round(Cells(Target.Row, "I") * Cells(Target.Row, "J"), 2)
        Cells(Target.Row, "M") = Round(Cells(Target.Row, "K") + Cells(Target.Row, "L"), 2)
        Cells(Target.Row, "O") = Round(Cells(Target.Row, "K") * 0.00948, 2)
        Cells(Target.Row, "T") = Round(Cells(Target.Row, "L") + Cells(Target.Row, "M") + Cells(Target.Row, "N") + Cells(Target.Row, "O") + Cells(Target.Row, "P") + Cells(Target.Row, "Q") + Cells(Target.Row, "R") + Cells(Target.Row, "S"), 2)
        Cells(Target.Row, "U") = Round(Cells(Target.Row, "K") - Cells(Target.Row, "T"), 2)
    Else
        If UCase(Cells(Target.Row, "G")) = "" Then

        MsgBox "Lütfen Vergi Türünü giriniz !", vbCritical
    End If
    End If
End Sub

G sütunu KDV' li ise alttaki makro
G Sütunu KDV'siz ise onun altındaki makro kodunun çalışmasını istedim. Ancak işlem yapmadı.
Rica etsem hatalı yaptığım yeri ve düzeltilmiş hali için yardımcı olabilir misiniz?

Saygılarımla
 
Merhaba,

UCase(Cells(Target.Row, "G")) yerine aşağıdaki gibi yazın.

UCase(Replace(Replace(Cells(Target.Row, "G"), "ı", "I"), "i", "İ"))

Ayrıca kodlardaki 1.şart olan "KDV'li" değerini kodların içinde büyük harf yazmanız gerekir. "KDV'Lİ"

.
 
Teşekkür ederim. Birde 2. koşul da sıkıntı var mı
 
UCase(Replace(Replace(Cells(Target.Row, "G"), "ı", "I"), "i", "İ"))

Bu değeri 1. ve 2. koşul için değiştirmeniz gerekir.
 
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G6:G250,I6:S250")) Is Nothing Then Exit Sub
    If UCase(Replace(Replace(Cells(Target.Row, "G"), "ı", "I"), "i", "İ")) = "KDV'Lİ" Then
        Cells(Target.Row, "K") = Round(Cells(Target.Row, "I") * Cells(Target.Row, "J"), 2)
        Cells(Target.Row, "L") = Round(Cells(Target.Row, "K") * 8 / 100, 2)
        Cells(Target.Row, "M") = Round(Cells(Target.Row, "K") + Cells(Target.Row, "L"), 2)
        Cells(Target.Row, "N") = Round(Cells(Target.Row, "L") / 2, 2)
        Cells(Target.Row, "O") = Round(Cells(Target.Row, "K") * 0.00948, 2)
        Cells(Target.Row, "T") = Round(Cells(Target.Row, "N") + Cells(Target.Row, "O") + Cells(Target.Row, "P") + Cells(Target.Row, "Q") + Cells(Target.Row, "R") + Cells(Target.Row, "S"), 2)
        Cells(Target.Row, "U") = Round(Cells(Target.Row, "K") - Cells(Target.Row, "T"), 2)
        
    ElseIf UCase(Replace(Replace(Replace(Cells(Target.Row, "G"), "s", "S"), "i", "İ"), "z", "Z")) = "KDV'SİZ" Then
        Cells(Target.Row, "K") = Round(Cells(Target.Row, "I") * Cells(Target.Row, "J"), 2)
        Cells(Target.Row, "M") = Round(Cells(Target.Row, "K") + Cells(Target.Row, "L"), 2)
        Cells(Target.Row, "O") = Round(Cells(Target.Row, "K") * 0.00948, 2)
        Cells(Target.Row, "T") = Round(Cells(Target.Row, "N") + Cells(Target.Row, "O") + Cells(Target.Row, "P") + Cells(Target.Row, "Q") + Cells(Target.Row, "R") + Cells(Target.Row, "S"), 2)
        Cells(Target.Row, "U") = Round(Cells(Target.Row, "K") - Cells(Target.Row, "T"), 2)
    Else
        If UCase(Cells(Target.Row, "G")) = "" Then

        MsgBox "Lütfen Vergi Türünü giriniz !", vbCritical
    End If
    End If
End Sub
Ömer abi eğer kod doğru ise bu sefer de "Excel Yanıt vermiyor" hatası veriyor.
 
Bu şekilde deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G6:G250,I6:S250")) Is Nothing Then Exit Sub
    
    On Error GoTo atla
    Application.EnableEvents = False
    
    If UCase(Replace(Replace(Cells(Target.Row, "G"), "ı", "I"), "i", "İ")) = "KDV'Lİ" Then
        Cells(Target.Row, "K") = Round(Cells(Target.Row, "I") * Cells(Target.Row, "J"), 2)
        Cells(Target.Row, "L") = Round(Cells(Target.Row, "K") * 8 / 100, 2)
        Cells(Target.Row, "M") = Round(Cells(Target.Row, "K") + Cells(Target.Row, "L"), 2)
        Cells(Target.Row, "N") = Round(Cells(Target.Row, "L") / 2, 2)
        Cells(Target.Row, "O") = Round(Cells(Target.Row, "K") * 0.00948, 2)
        Cells(Target.Row, "T") = Round(Cells(Target.Row, "N") + Cells(Target.Row, "O") + Cells(Target.Row, "P") + Cells(Target.Row, "Q") + Cells(Target.Row, "R") + Cells(Target.Row, "S"), 2)
        Cells(Target.Row, "U") = Round(Cells(Target.Row, "K") - Cells(Target.Row, "T"), 2)
        
    ElseIf UCase(Replace(Replace(Cells(Target.Row, "G"), "ı", "I"), "i", "İ")) = "KDV'SİZ" Then
        Cells(Target.Row, "K") = Round(Cells(Target.Row, "I") * Cells(Target.Row, "J"), 2)
        Cells(Target.Row, "M") = Round(Cells(Target.Row, "K") + Cells(Target.Row, "L"), 2)
        Cells(Target.Row, "O") = Round(Cells(Target.Row, "K") * 0.00948, 2)
        Cells(Target.Row, "T") = Round(Cells(Target.Row, "N") + Cells(Target.Row, "O") + Cells(Target.Row, "P") + Cells(Target.Row, "Q") + Cells(Target.Row, "R") + Cells(Target.Row, "S"), 2)
        Cells(Target.Row, "U") = Round(Cells(Target.Row, "K") - Cells(Target.Row, "T"), 2)
    Else
        If UCase(Cells(Target.Row, "G")) = "" Then
            MsgBox "Lütfen Vergi Türünü giriniz !", vbCritical
        End If
    End If
    Application.EnableEvents = True
    Exit Sub
atla:
    Application.EnableEvents = True
End Sub
 
Allah Yar ve Yardımcınız Olsun. Teşekkür eder, saygılarımı sunarım
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst