Soru Makro İle Şartlı Hesaplama

[Hsn55]

İyi akşamlar;
Ekli örnek dosyada O4:Z25.000 hücre aralığındaki verileri şarta göre makro ile nasıl hesaplatabiliriz.
1-O hücresine Bedel oranını yazdığımda P hücresini "Ödendi" ise "Ödenmedi" yapacak, "Ödenmedi İse İşlem Yapmayacak.
2-O hücresi ile Q hücresini çarpıp 100 bölecek ve sonucu Q hücresine yazacak
3-Q hücresindeki verinin hesaplanmadan önceki değerini Z hücresine yazacak
4-Bu işlemlerin tümü S hücresi Bedelli ise yapacak. Bedelsizlerde hesap yapmayacak

İndir Formül

Dosyayı indir Formül

dosya.co

 

[Hsn55]

İyi geceler,
Rica etsem konuya yardımcı olabilir misiniz

 

[ÖmerFaruk]

Aşağıdkai kodları sayfanızın KOD sayfasına aynen yapıştırıp O4:O25000 aralığında sayıları yazmaya başlayabilirsiniz.
Yanlış anlamış olabilirm diye dosyanızın yedeğini alın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("O4:O25000")) Is Nothing Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    If Range("S" & Target.Row) <> "Bedelli" Then Exit Sub
    Application.EnableEvents = False
    If Range("P" & Target.Row) = "Ödendi" Then Range("P" & Target.Row) = "Ödenmedi"
    Range("Z" & Target.Row) = Range("Q" & Target.Row)
    Range("Q" & Target.Row) = Range("O" & Target.Row) * Range("Q" & Target.Row) / 100
    Application.EnableEvents = True
End Sub

 

[Hsn55]

Ömer hocam şöyle olabilir mi?
Ben d2 hücresine Bedel oranını yazdığımda S sütununda "Bedelli" yazıyorsa O sütununda bedelli yazanların karşısına d2 hücresindeki bedel oranını yazacak ve hesaplamaları buton ile yapacak. Butonu ben başka sayfadan da çalıştırabilmeliyim. Birde Q sütundaki verinin üzerine O*Q=Q olarak hesaplayacak

 

[ÖmerFaruk]

1. d2 den kastınız d sütunundaki her satır mı?
2. ilk sorunuzda O4:O25000 demiştiniz. şimdi d2 yani 2. satır diyorsunuz. gönderdiğiniz dosyada veriler 3.satırdan başlıyor. doğrusu hangisi?
3. Mesela d2 - d3 - d4 üçüne de bir değer yazınca işlemleri 2-3-4.satırların hepsi için mi yapacak?
4. il mesajınızda O=O*Q/100 demiştiniz şimdi 100'e bölmekten vaz mı geçtiniz?
5. P ve Z sütunları için son mesajınızda bir şey yazmamışsınız. Bir şey yapılmayacak mı?

Lütfen sorulara aynı sıra numarasıyla cevap veriniz.

 

[Hsn55]

Hocam birde "P" sütununda ödenmedi yazarsa hesaplama yapmayacak.

 

[Hsn55]

sadece D2 hücresi (Bedel oranı) bu oran bütün O sütünların hepsinde geçerli olacak.D2 hücresine veri girdiğimde bu verileri S sütununda bedelli yazıyorsa O sütununa D2 hücresindeki veriyi yazacak ve butona basınca hesaplayacak.4 Maddeyi ben şu şekilde uyguladım hocam
Hocam birde "P" sütununda ödenmedi yazarsa hesaplama yapmayacak.

 Range("Q" & Target.Row) = Range("Q" & Target.Row) + Range("Q" & Target.Row) * Range("O" & Target.Row) / 100

 

[ÖmerFaruk]

5 nolu mesajımın en altındaki satırı okuyabildiniz mi?

 

[Hsn55]

1-Sadece D2 hücresi (Bedel oranı) bu oran bütün O sütunların hepsinde geçerli olacak
2-3 satırdan başlayacak
3-D2 hücresine veri girdiğimde bu verileri S sütununda bedelli yazıyorsa O sütununa D2 hücresindeki veriyi yazacak
4- Bu maddeyi aşağıdaki makro ile halletim

Range("Q" & Target.Row) = Range("Q" & Target.Row) + Range("Q" & Target.Row) * Range("O" & Target.Row) / 100

5- P sütununda Ödenmedi yazarsa hesaplama yapmayacak .Z sütununu zaten yapmışşsınız sıkıntı yok

 

[ÖmerFaruk]

Ve bunu tüm O3:Z25000 aralığında mı yapacak?
Yoksa dolu olan son satıra kadar mı?

 

[Hsn55]

dolu olan son satır olsa iyi olur hocam

 

[ÖmerFaruk]

Herhangi bir satırda işlem yapması için; hem S sütununda "Bedelli" hem de P sütununda "Ödendi" mi yazıyor olmalı?

 

[Hsn55]

Evet

 

[ÖmerFaruk]

Aşağıdaki kodu bir modul içine ekleyin.
İstediğiniz sayfadaki butonlara bu makroyu atayın.
Yedek almayı unutmayın.
Elde sadece 2 satır veri olduğu için 2 satırda denedim. Siz kendi dosyanızda test edebilirsiniz.

Sub Formül()
Dim Veri As Variant, Liste, i As Long, k As Integer, Deger As Double
    With Worksheets("Sayfa1")
        Deger = .Range("D2").Value
        If Not IsNumeric(Deger) Then Exit Sub
        son = .Range("O3").End(xlDown).Row
        Veri = .Range("O3:Z" & son).Value
        ReDim Liste(1 To UBound(Veri, 1), 1 To UBound(Veri, 2))
        For i = 1 To UBound(Veri)
            For k = 1 To UBound(Veri, 2)
                Liste(i, k) = Veri(i, k)
            Next k
            If Veri(i, 2) = "Ödendi" And Trim(Veri(i, 5)) = "Bedelli" Then
                Liste(i, 1) = Deger
                Liste(i, 2) = "Ödenmedi"
                Liste(i, 12) = Liste(i, 3)
                Liste(i, 3) = Liste(i, 3) + Liste(i, 3) * Deger / 100
                Liste(i, 5) = Trim(Liste(i, 5))
            End If
        Next i
        .Range("O3").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Liste
        Erase Liste
    End With
End Sub

 

[Hsn55]

Teşekkür ederim. Ömer hocam ellerinize sağlık. Hayırlı geceler

 

[ÖmerFaruk]

Hayırlı geceler.