Hem $ hem Tl giriş Tablosu.

I

ismail-34

Katılım
9 Ekim 2021
Mesajlar
337
Excel Vers. ve Dili
excell 2013
Altın Üyelik Bitiş Tarihi
19-12-2023
Excel Web Ailesine Selamlar.

Benim Sorum daha önce hep formülle hesaplanan tablomdaki formüllerin otomatik makro ile hesaplanabilmesi üzerine.
Örnekte göreceğiniz üzere, $ olarak hesaplama yapılan ilk satırda d ve e sütunları boş bırakılacağı zaman g deki formül uygulansın istiyorum.
Tl ile hesaplama yapılacağı zaman yani e sütunu dolu olduğu zaman ise f , g ve h daki formül uygulansın istiyorum.

Böyle bir şey gerçekten çok işime yarardı.

Değerli Uzmanlara Saygılarımla.
 

Ekli dosyalar

I

ismail-34

Katılım
9 Ekim 2021
Mesajlar
337
Excel Vers. ve Dili
excell 2013
Altın Üyelik Bitiş Tarihi
19-12-2023
Korhan Ayhan' Alıntı:
Ekteki gibi olabilir.

Manuel tutar girişlerinizi "I" sütununa yapınız.
Genişletmek için tıkla ...
Çok Değerli Korhan hocam başta belirttiğim üzere formülsüz makro kodu ile çalışan bir sistem çok işime yarardı. Emeğiniz için tekrar müteşekkirim.Eğer makro kodlu çözüm çıkmaz ise Bendeki formülden daha gelişmiş (denetlemeli) bunu mutlaka kullanacağım tabiki..
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,298
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Mesajınızda "formül uygulansın" ifadesini kullanınca konun makrolar bölümünde olması açıkçası dikkatimi çekmedi.
 
I

ismail-34

Katılım
9 Ekim 2021
Mesajlar
337
Excel Vers. ve Dili
excell 2013
Altın Üyelik Bitiş Tarihi
19-12-2023
Değerli Hocalarım Makro kodlu çözüm yok sanırım ?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,298
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp deneyiniz.

Çoklu veri girişlerinde biraz bekleme yapabilir. Bu sebeple kontrollü kullanmanızda fayda var.

C++: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Son As Long, Usd As Variant, Try As Variant, Satir As Long

    Son = Cells(Rows.Count, "B").End(3).Row
    
    If Intersect(Target, Range("A2:H" & Son)) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error Resume Next
    
    For Each Veri In Intersect(Target, Range("A2:H" & Son)).Cells
        If Satir <> Veri.Row Then
            Try = Cells(Veri.Row, "E")
            Usd = Cells(Veri.Row, "H")
            If Veri.Column = 5 Then
                If Try = Empty Then
                    Cells(Veri.Row, "F").ClearContents
                    Cells(Veri.Row, "G") = Usd / Cells(Veri.Row, "C")
                ElseIf IsNumeric(Try) Then
                    Cells(Veri.Row, "F") = Try / Cells(Veri.Row, "C")
                    Cells(Veri.Row, "G") = Cells(Veri.Row, "F") / Range("W2")
                    Cells(Veri.Row, "H") = Try / Range("W2")
                End If
            ElseIf Veri.Column = 8 Then
                If Usd = Empty Then
                    Cells(Veri.Row, "E").Resize(1, 3).ClearContents
                ElseIf IsNumeric(Usd) Then
                    Cells(Veri.Row, "E").Resize(1, 3).ClearContents
                    Cells(Veri.Row, "G") = Usd / Cells(Veri.Row, "C")
                End If
            Else
                If Try <> "" Then
                    If IsNumeric(Try) Then
                        Cells(Veri.Row, "F") = Try / Cells(Veri.Row, "C")
                        Cells(Veri.Row, "G") = Cells(Veri.Row, "F") / Range("W2")
                        Cells(Veri.Row, "H") = Try / Range("W2")
                    End If
                ElseIf Usd <> "" Then
                    If IsNumeric(Usd) Then
                        Cells(Veri.Row, "E").Resize(1, 3).ClearContents
                        Cells(Veri.Row, "G") = Usd / Cells(Veri.Row, "C")
                    End If
                End If
            End If
        End If
        Satir = Veri.Row
    Next

    On Error GoTo 0
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
I

ismail-34

Katılım
9 Ekim 2021
Mesajlar
337
Excel Vers. ve Dili
excell 2013
Altın Üyelik Bitiş Tarihi
19-12-2023
Korhan Ayhan' Alıntı:
Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp deneyiniz.

Çoklu veri girişlerinde biraz bekleme yapabilir. Bu sebeple kontrollü kullanmanızda fayda var.

C++: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Son As Long, Usd As Variant, Try As Variant, Satir As Long

    Son = Cells(Rows.Count, "B").End(3).Row
   
    If Intersect(Target, Range("A2:H" & Son)) Is Nothing Then Exit Sub
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    On Error Resume Next
   
    For Each Veri In Intersect(Target, Range("A2:H" & Son)).Cells
        If Satir <> Veri.Row Then
            Try = Cells(Veri.Row, "E")
            Usd = Cells(Veri.Row, "H")
            If Veri.Column = 5 Then
                If Try = Empty Then
                    Cells(Veri.Row, "F").ClearContents
                    Cells(Veri.Row, "G") = Usd / Cells(Veri.Row, "C")
                ElseIf IsNumeric(Try) Then
                    Cells(Veri.Row, "F") = Try / Cells(Veri.Row, "C")
                    Cells(Veri.Row, "G") = Cells(Veri.Row, "F") / Range("W2")
                    Cells(Veri.Row, "H") = Try / Range("W2")
                End If
            ElseIf Veri.Column = 8 Then
                If Usd = Empty Then
                    Cells(Veri.Row, "E").Resize(1, 3).ClearContents
                ElseIf IsNumeric(Usd) Then
                    Cells(Veri.Row, "E").Resize(1, 3).ClearContents
                    Cells(Veri.Row, "G") = Usd / Cells(Veri.Row, "C")
                End If
            Else
                If Try <> "" Then
                    If IsNumeric(Try) Then
                        Cells(Veri.Row, "F") = Try / Cells(Veri.Row, "C")
                        Cells(Veri.Row, "G") = Cells(Veri.Row, "F") / Range("W2")
                        Cells(Veri.Row, "H") = Try / Range("W2")
                    End If
                ElseIf Usd <> "" Then
                    If IsNumeric(Usd) Then
                        Cells(Veri.Row, "E").Resize(1, 3).ClearContents
                        Cells(Veri.Row, "G") = Usd / Cells(Veri.Row, "C")
                    End If
                End If
            End If
        End If
        Satir = Veri.Row
    Next

    On Error GoTo 0
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Hocam süper. yanlız örneğimde olduğu gibi . TL hesaplarken g sütununa =(E3/C3)/W2 formülünü h sütununa ise =G3*C3 formülünü uygulanmasınıda rica ediyorum.Bu eksik kısmıda tamamlarsak çok sevinirim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,298
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bahsettiğiniz hesaplamanın yapılıyor olması gerekir.

E sütununa TL değer girerek deneyebilirsiniz.
 
I

ismail-34

Katılım
9 Ekim 2021
Mesajlar
337
Excel Vers. ve Dili
excell 2013
Altın Üyelik Bitiş Tarihi
19-12-2023
Korhan Ayhan' Alıntı:
Bahsettiğiniz hesaplamanın yapılıyor olması gerekir.

E sütununa TL değer girerek deneyebilirsiniz.
Genişletmek için tıkla ...
Çok Değerli hocam tekrar denedim oldu. haklısınız çok özür dilerim. İnanılmaz işime yaradı.Sağolun varolun valla.Yolunuz açık olsun.

Diğer Arkadaşlarda fatura formüllerini makroya taşımaları için faydalı bir eser.

ekte tüm altın üyelerin faydalanmaları için dosyamı koyuyorum.

Tüm Excel Web ailesine selamlar.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Üst