SÜTUNLARIN KARŞILAŞTIRILMASI

[Abdurrahmantimocin]

Merhaba,

Sayılardan oluşan A ve D sütununu karşılaştırarak aynı sayı ise B sütununda bulunan müşteri isimlerini çekmesini istiyorum. Bunun için nasıl bir formül yazmalıyım yardımcı olurmusunuz

 

[çıtır]

Sorunuzu örnek excel dosyası ekleyerek sorarsanız,daha kısa sürede doğru cevaplar alabilirsiniz. Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz: https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/...

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

=EĞERHATA(DÜŞEYARA(D2;A:B;2;0);"")

 

[Abdurrahmantimocin]

Sağol üstat. teşekkürler

 

[zaruri]

Bu sorudan devam edebiliriz sanırım.

alan ve satan firmanın faturalarını karşılaştıran bir çalışma var.

Burada, bir düğme ile;
Fatura tarihi:
fatura no: ve
fatura tutarları: 'nı
karşılaştırmak istiyoruz.
çalışma sadece fatura no'yu karşılaştırmış.
bazı faturalar, alıcıya, bir kaç parçada gönderilmiş olabiliyor.
Sadece "FaturaTutarı" karşılaştırma ile yetinecektim fakat yapamadım.
Yardımlarınızı bekliyorum.

 

[Ömer]

Merhaba,
Karşılaştırmadan kastınız nedir. Soruyu detaylandırınız.

 

[zaruri]

Sipariş edilen ürünlerin faturaları ile depoya gelen ürünlerin faturaları karşılaştırılıyor.
gelmeyen faturalar tespit ediliyor.
bazı faturalar parça parça gelebiliyor.
Satıcıda bir adet görünen fatura alıcıda beş altı adet olabiliyor.
Ekte görüleceği üzere, sütunları tek tek karşılaştırdığımızda daha verimli sonuç elde edilebilir.

ekte biraz daha açıklamalı örneği görebilirsiniz.

 

[zaruri]

Ömer Üstadım, ilginize teşekkür ederim.
Satırları azaltamadım, sorun olur mu bilmiyorum.
"sipariş", "gelen" ve "kalan" olarak analiz yapılması gerekiyor, sipariş faturaları parça parça geliyor tek faturaya giriş yapılıyor kontrol orada güçleşiyor.

 

[YUSUF44]

Aşağıdaki makroyu dener misiniz?

Sub fatura()
sonS = Cells(Rows.Count, "B").End(3).Row
sonG = Cells(Rows.Count, "F").End(3).Row
eski = WorksheetFunction.Max(Cells(Rows.Count, "K").End(3).Row, 3)
Range("K3:M" & eski).ClearContents
For i = 3 To sonS
    If WorksheetFunction.CountIfs(Range("B3:B" & i), Cells(i, "B"), Range("C3:C" & i), Cells(i, "C")) = 1 Then
        If WorksheetFunction.SumIfs(Range("D3:D" & sonS), Range("B3:B" & sonS), Cells(i, "B"), Range("C3:C" & sonS), Cells(i, "C")) > _
            WorksheetFunction.SumIfs(Range("H3:H" & sonG), Range("F3:F" & sonG), Cells(i, "B"), Range("G3:G" & sonG), Cells(i, "C")) Then
            yeni = Cells(Rows.Count, "K").End(3).Row + 1
            Cells(yeni, "K") = Cells(i, "B")
            Cells(yeni, "L") = Cells(i, "C")
            Cells(yeni, "M") = WorksheetFunction.SumIfs(Range("D3:D" & sonS), Range("B3:B" & sonS), Cells(i, "B"), Range("C3:C" & sonS), Cells(i, "C")) - _
            WorksheetFunction.SumIfs(Range("H3:H" & sonG), Range("F3:F" & sonG), Cells(i, "B"), Range("G3:G" & sonG), Cells(i, "C"))
        End If
    End If
Next
End Sub

Not: Kodda düzenleme yapılmıştır.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Fark()

    Dim d As Object, deg As String, i As Long, a1, a2, s, a As Double, sat As Long
  
    Application.ScreenUpdating = False

    Set d = CreateObject("Scripting.Dictionary")

    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        deg = Cells(i, "C")
        If Not d.exists(deg) Then
            s = Array(Cells(i, "B"), Cells(i, "D"))
            d.Add deg, s
        Else
            s = d.Item(deg)
            s(1) = s(1) + Cells(i, "D")
            d.Item(deg) = s
        End If
    Next i

    Range("K3:M" & Rows.Count).ClearContents
    a1 = d.keys: a2 = d.items: sat = 3
  
    For i = 0 To d.Count - 1
        s = a2(i)
        a = WorksheetFunction.SumIf([G:G], a1(i), [H:H])
        If Round(s(1) - a, 2) > 0 Then
            Cells(sat, "L") = a1(i)
            Cells(sat, "K") = s(0)
            Cells(sat, "M") = s(1) - a
            sat = sat + 1
        End If
    Next i
  
End Sub

 

[zaruri]

İlginize teşekkür ederim, olması gereken sonucu manuel olarak çıkarttım, çalışmanın yan sütununa ekledim.

 

[zaruri]

Ömer üstadım, makroyu çalıştırdım, fark fazla çıktı.

 

[Ömer]

#10 numaralı mesajdaki kodu güncelledim, denermisiniz.
Sizinkinden farkı, listeleme de birden fazla fatura varsa veriler toplanarak geliyor, isterseniz ayrı ayrı da yapılabilir.

Ayrıca eğer farkları aldıktan sonra silinmesini isterseniz aşağıdaki kodları deneyin.

Sub Fark_Yaz_Sil()

    Dim d As Object, deg As String, i As Long, a1, a2, s, a As Double, sat As Long
    Dim c As Range, cs As Range, Adr As String, k As Range, ks As Range, Adr1 As String

    Application.ScreenUpdating = False

    Set d = CreateObject("Scripting.Dictionary")

    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        deg = Cells(i, "C")
        If Not d.exists(deg) Then
            s = Array(Cells(i, "B"), Cells(i, "D"))
            d.Add deg, s
        Else
            s = d.Item(deg)
            s(1) = s(1) + Cells(i, "D")
            d.Item(deg) = s
        End If
    Next i

    Range("K3:M" & Rows.Count).ClearContents
    a1 = d.keys: a2 = d.items: sat = 3

    For i = 0 To d.Count - 1
        s = a2(i)
        a = WorksheetFunction.SumIf([G:G], a1(i), [H:H])
        If Round(s(1) - a, 2) > 0 Then
            Cells(sat, "L") = a1(i)
            Cells(sat, "K") = s(0)
            Cells(sat, "M") = s(1) - a
            sat = sat + 1
        Else
       
            Set c = [C:C].Find(a1(i), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    If cs Is Nothing Then
                        Set cs = Cells(c.Row, "B").Resize(1, 3)
                    Else
                      Set cs = Application.Union(cs, Cells(c.Row, "B").Resize(1, 3))
                    End If
                    Set c = [C:C].FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
           
            Set k = [G:G].Find(a1(i), , xlValues, xlWhole)
            If Not k Is Nothing Then
                Adr1 = k.Address
                Do
                    If ks Is Nothing Then
                        Set ks = Cells(k.Row, "F").Resize(1, 3)
                    Else
                      Set ks = Application.Union(ks, Cells(k.Row, "F").Resize(1, 3))
                    End If
                    Set k = [G:G].FindNext(k)
                Loop While Not k Is Nothing And k.Address <> Adr1
            End If
           
        End If
    Next i
   
    On Error Resume Next
    cs.Delete Shift:=xlUp
    ks.Delete Shift:=xlUp
   
End Sub

 

[zaruri]

Hocam Şimdi Tamam, Elinize, emeğinize sağlık.
İlgilerinize teşekkür ederim.

 

[zaruri]

Değerli Hocalarım Yukarıda yapılan Çalışmalardan esinlenerek,
Bir kontrol daha oluşturmaya çalıştım.
Fakat,
Sipariş edilen ürünler,
Parça parça geldiği için kontrolü zorlaşıyor.

Ekte gönderilen çalışmayı "tek bir sütunda" nasıl kontrol edebilirim.

İlginiz için şimdiden teşekkür ederim.