İki şartlı formül

[sbayyigit]

Merhaba arkadaşlar,
Örnekdeki şekilde bir formüle ihtiyacım var
Eğer (g sütunundaki )Belge no,(L sütunundaki) fiş No sütununda yok ise "Yok" Yazılacak eğer Aynı Belge No var ise; ikinci şart olarak (ı sütunundaki) fiş tutarı ile ( M sütunundaki) değerler karşılaştırılacak. Tutarlar aynı ise "Tutarlı", tutarlar farklı ise "Tutarlar hatalı" şeklinde yazılması gerekiyor.

 

[Ömer]

Merhaba,

Deneyiniz.

=EĞER(G2<>L2;"Yok";EĞER(VE(G2=L2;I2=M2);"Tutarlı";"Tutarlar Hatalı"))

 

[sbayyigit]

Ömer hocam sanırım tam olarak anlatamadım. aynı veriler aynı satırda olmayabiliyor. Örneğin 18 nolu belge numarası 3. satırda iken, 18 nolu fiş aynı sütunda fakat 500. satırda olabiliyor.

 

[Ömer]

Deneyiniz.

=EĞER(EĞERSAY(L:L;G2)=0;"Yok";EĞER(I2=İNDİS(M:M;KAÇINCI(G2;L:L;0));"Tutarlı";"Tutarlar Hatalı"))

 

[sbayyigit]

Çok teşekkür ederim Ömer Hocam.

 

[sbayyigit]

Ömer hocam Liste çok uzun. Makro ile yapmak mümkün mü?

 

[sbayyigit]

Basit şekilde anca böyle sonuç buldum.

Sub karsilastir()
Set s1 = Sheets("sayfa1")
sat = s1.[a100].End(3).Row
For a = 2 To sat
For b = 2 To sat
Belge_no = s1.Range("g" & a).Value
Fis_no = s1.Range("l" & a).Value
If Belge_no = Fis_no Then
s1.Range("o" & a).Value = "Kayıt var Tutarı Kontrol Et"
Belge_tutar = s1.Range("ı" & a).Value
Fis_tutar = s1.Range("m" & a).Value
If s1.Range("ı" & a).Value = s1.Range("m" & a).Value Then
s1.Range("o" & a).Value = "Tutarlı"
GoTo 20
End If
Else: s1.Range("o" & a).Value = "Kayıt Bulunamadı"
End If
Next b
20
Next a
End Sub

 

[Ömer]

Formül mantığıyla yazdım.

Sub hesapla()
    
    Dim i As Long, son As Long, s As Long, d As Double, Wf As WorksheetFunction
    
    Set Wf = WorksheetFunction
    son = Cells(Rows.Count, "L").End(xlUp).Row
    
    Application.ScreenUpdating = False
    Range("K2:K" & Rows.Count).ClearContents
    
    For i = 2 To son
        s = Wf.CountIf(Range("L2:L" & son), Cells(i, "G"))
        If s = 0 Then
            Cells(i, "K") = "Yok"
        Else
            d = Wf.Index(Range("M2:M" & son), Wf.Match(Cells(i, "G"), Range("L2:L" & son), 0))
            If Cells(i, "I") = d Then
                Cells(i, "K") = "Tutarlı"
            Else
                Cells(i, "K") = "Tutarlar Hatalı"
            End If
        End If
    Next i
    
End Sub

 

[Korhan Ayhan]

Alternatif;

Hız olarak avantaj sağlayabilir.

Option Explicit

Sub Listeleri_Kontrol_Et()
    Dim Zaman As Double, S1 As Worksheet, Dizi As Object
    Dim Veri As Variant, Son As Long, Say As Long, X As Long
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S1.Cells(S1.Rows.Count, "L").End(3).Row
    
    If Son <= 2 Then Son = 3
    
    Veri = S1.Range("L2:N" & Son).Value
    
    ReDim Liste_A(1 To Son, 1 To 2)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Not Dizi.Exists(Veri(X, 1)) Then
            Say = Say + 1
            Dizi.Add Veri(X, 1), Say
            Liste_A(Say, 1) = Veri(X, 1)
            Liste_A(Say, 2) = Veri(X, 2)
        Else
            Liste_A(Dizi.Item(Veri(X, 1)), 2) = Liste_A(Dizi.Item(Veri(X, 1)), 2) + Veri(X, 2)
        End If
    Next
    
    
    Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
    
    If Son <= 2 Then Son = 3
    
    Veri = S1.Range("A2:J" & Son).Value
    
    ReDim Liste_B(1 To Son, 1 To 1)
    
    Say = 0
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Say = Say + 1
        If Dizi.Exists(Veri(X, 7)) Then
            If Liste_A(Dizi.Item(Veri(X, 7)), 2) = Veri(X, 9) Then
                Liste_B(Say, 1) = "Tutarlı"
            Else
                Liste_B(Say, 1) = "Tutarlar Farklı"
            End If
        Else
            Liste_B(Say, 1) = "Yok"
        End If
    Next
    
    If Say > 0 Then
        S1.Range("K2").Resize(Say) = Liste_B
        MsgBox "Kontrol işlemi tamamlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Kontrol edilecek veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set Dizi = Nothing
End Sub

 

[ALTINYAYLA]

Kıymetli ustalarım benim de benzer bir formüle ihtiyacım var. yoğunlaşamadım. şimdiden teşekkür ederim.

 

[Ömer]

Sorunuzu tam anlayamadım. E sütununda olması gereken değerleri nedenleriyle yazıp yeni bir dosya ekler misiniz.

 

[ALTINYAYLA]

Tamam hocam buyrun. Şimdiden teşekkür ediyorum.

 

[Ömer]

Benim söylemek istediğim bu değildi.
Verdiğiniz örnekteki E2,E3,E4,E5 hücrelerine hangi değerler gelmeli ve neden? Bunu açıklar mısınız.

 

[ALTINYAYLA]

eğer d2, d3, d4 ve d5 hücrelerinin herhangi en büyük değer ile en küçük değer arasındaki artı fark %20 nin üzerindeyse "SAT" yazısı çıkacak, tam tersi ise yani %20 aşağısında ise "al" yazacak, fark %20 nin altında ise "bekle" yazacak. Teşekkür ederim.

 

[Ömer]

Ben yine derdimi anlatamadım sanırım.

D2 = 25 , E2= ne olmalı ( al,sat,bekle ve neden)
gibi E2,E3,E4 ve E5 değerlerinin sonuçlarını yazıp açıklar mısınız demek istedim.

 

[ALTINYAYLA]

E2 Hücresindeki olmasını istediğim formül = eğer d2,d3,d4, d5 ten hangisi en büyüktür.
o en büyük olan tutar yine d2,d3,d4, d5 deki rakamlardan en KÜÇÜĞÜ olandan %20 büyükse SAT,
eğer o değer d2,d3,d4, d5 deki rakamlardan en BÜYÜĞÜ olandan %20 küçükse AL,
eğer o değer d2,d3,d4, d5 deki rakamlardan büyüğü /küçüğü FARKI %20 nin altındaysa DUR Yazacak.
inşallah anlatabilmişimdir hocam. Selamlarımla...

 

[sbayyigit]

Söylediklerinizden anladığım kadarıyla
=EĞER((MAK(A44)-MİN(A44))>(MİN(A44)+1,2);"SAT";"AL")

 

[sbayyigit]

Formül mantığıyla yazdım.

Sub hesapla()
   
    Dim i As Long, son As Long, s As Long, d As Double, Wf As WorksheetFunction
   
    Set Wf = WorksheetFunction
    son = Cells(Rows.Count, "L").End(xlUp).Row
   
    Application.ScreenUpdating = False
    Range("K2:K" & Rows.Count).ClearContents
   
    For i = 2 To son
        s = Wf.CountIf(Range("L2:L" & son), Cells(i, "G"))
        If s = 0 Then
            Cells(i, "K") = "Yok"
        Else
            d = Wf.Index(Range("M2:M" & son), Wf.Match(Cells(i, "G"), Range("L2:L" & son), 0))
            If Cells(i, "I") = d Then
                Cells(i, "K") = "Tutarlı"
            Else
                Cells(i, "K") = "Tutarlar Hatalı"
            End If
        End If
    Next i
   
End Sub

teşekkürler

 

[sbayyigit]

Alternatif;

Hız olarak avantaj sağlayabilir.

Option Explicit

Sub Listeleri_Kontrol_Et()
    Dim Zaman As Double, S1 As Worksheet, Dizi As Object
    Dim Veri As Variant, Son As Long, Say As Long, X As Long
   
    Zaman = Timer
   
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Son = S1.Cells(S1.Rows.Count, "L").End(3).Row
   
    If Son <= 2 Then Son = 3
   
    Veri = S1.Range("L2:N" & Son).Value
   
    ReDim Liste_A(1 To Son, 1 To 2)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Not Dizi.Exists(Veri(X, 1)) Then
            Say = Say + 1
            Dizi.Add Veri(X, 1), Say
            Liste_A(Say, 1) = Veri(X, 1)
            Liste_A(Say, 2) = Veri(X, 2)
        Else
            Liste_A(Dizi.Item(Veri(X, 1)), 2) = Liste_A(Dizi.Item(Veri(X, 1)), 2) + Veri(X, 2)
        End If
    Next
   
   
    Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
   
    If Son <= 2 Then Son = 3
   
    Veri = S1.Range("A2:J" & Son).Value
   
    ReDim Liste_B(1 To Son, 1 To 1)
   
    Say = 0
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Say = Say + 1
        If Dizi.Exists(Veri(X, 7)) Then
            If Liste_A(Dizi.Item(Veri(X, 7)), 2) = Veri(X, 9) Then
                Liste_B(Say, 1) = "Tutarlı"
            Else
                Liste_B(Say, 1) = "Tutarlar Farklı"
            End If
        Else
            Liste_B(Say, 1) = "Yok"
        End If
    Next
   
    If Say > 0 Then
        S1.Range("K2").Resize(Say) = Liste_B
        MsgBox "Kontrol işlemi tamamlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Kontrol edilecek veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set Dizi = Nothing
End Sub

Çık Hızlı çözdü. Teşekkürler Hocam

 

[ALTINYAYLA]

Maalesef olmadı üstad. Sanırım ben meramımı tam anlatamadım.