vade ve tutara göre cari eşleştirme

[igultekin2000]

iyi günler
Raporlama soncu alınan ve verilen çeklerin raporu, ayrı sayfada da firmaya girip-çıkan çek ve vadelerin raporlaması yapılıyor. aynı tarih ve tutar' lı çekin farklı firmalardan alınabiliyor ve verilebiliyor. vade ve tutara göre firmalara eşleştirmek istiyorum. aynı tarih ve tutar olunca çözemedim, formül veya makro ile çözüm tavsiyelerini talep etmekteyim. Teşekkürler.
not: Borç alınan Çekleri, Alacak çıkan Çekleri göstermektir.

 

[Ziynettin]

Dosyanız ekte.

Kodu çalıştır ve sayfa1 C sütununu kontrol ediniz.

 

[igultekin2000]

Dosyanız ekte.

Kodu çalıştır ve sayfa1 C sütununu kontrol ediniz.

Teşekkür ederim, yalnız D, E ,F deki çıkışla ilgili eşleştirmeyi ilave etmeye çalıştım ama yapamadı, çıkışı de eşleştirme imkanı olabilirse sevinirim.

 

[Ziynettin]

Oması gereken sonucu dosya üzerinden paylaşırmızın.

 

[igultekin2000]

Oması gereken sonucu dosya üzerinden paylaşırmızın.

görütü olarak bu şekildeEkli dosyayı görüntüle 211561

 

[Suskun]

Benzer özellikler olduğu için eşleştirme yapmanız mümkün değil. İşlemleri Çekleri numaralandırıp yapmayı deneyin .

 

[igultekin2000]

Benzer özellikler olduğu için eşleştirme yapmanız mümkün değil. İşlemleri Çekleri numaralandırıp yapmayı deneyin .

Girişe göre

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
a = s2.Range("B2:E" & s2.Cells(Rows.Count, 2).End(3).Row).Value
For i = 1 To UBound(a)
    krt = CStr(a(i, 1)) & "|" & CStr(a(i, 2))
    d1(krt) = d1(krt) & "|" & i
    d2(krt) = d2(krt) + 1
Next i
b = s1.Range("A2:B" & s1.Cells(Rows.Count, 2).End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 1)
For i = 1 To UBound(b)
    krt = CStr(b(i, 1)) & "|" & CStr(b(i, 2))
    d3(krt) = d3(krt) + 1
    If d3(krt) <= d2(krt) Then
        sat = Split(d1(krt), "|")(d3(krt))
        c(i, 1) = a(sat, 4)
    End If
Next i
s1.[C2].Resize(UBound(b)) = c
MsgBox "İşlem tamam.", vbInformation
End Sub

bu koda göre giriştekiler eşleşiyor, ayın kodu çıkıştakilere de uygulamak gerekiyor, kodu ayarlaymadım

 

[Korhan Ayhan]

Formülle çözümü inceleyiniz. Artan verilerde doğruluğunu kontrol ediniz.

 

[igultekin2000]

Formülle çözümü inceleyiniz. Artan verilerde doğruluğunu kontrol ediniz.

teşekkür ederim, sorunsuz çalışıyor. iyi çalışmalar

 

[Ziynettin]

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Set d11 = CreateObject("scripting.dictionary")
Set d22 = CreateObject("scripting.dictionary")
Set d33 = CreateObject("scripting.dictionary")
a = s2.Range("B2:E" & s2.Cells(Rows.Count, 2).End(3).Row).Value
For i = 1 To UBound(a)
    krt = CStr(a(i, 1)) & "|" & CStr(a(i, 2))
    d1(krt) = d1(krt) & "|" & i
    d2(krt) = d2(krt) + 1
    krt2 = CStr(a(i, 1)) & "|" & CStr(a(i, 3))
    d11(krt2) = d11(krt2) & "|" & i
    d22(krt2) = d22(krt2) + 1
Next i
b = s1.Range("A2:E" & s1.Cells(Rows.Count, 2).End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 1)
ReDim cc(1 To UBound(b), 1 To 1)
For i = 1 To UBound(b)
    krt = CStr(b(i, 1)) & "|" & CStr(b(i, 2))
    d3(krt) = d3(krt) + 1
    If d3(krt) <= d2(krt) Then
        sat = Split(d1(krt), "|")(d3(krt))
        c(i, 1) = a(sat, 4)
    End If
    krt2 = CStr(b(i, 4)) & "|" & CStr(b(i, 5))
    d33(krt2) = d33(krt2) + 1
    If d33(krt2) <= d22(krt2) Then
        sat2 = Split(d11(krt2), "|")(d33(krt2))
        cc(i, 1) = a(sat2, 4)
    End If
Next i
s1.[C2].Resize(UBound(b)) = c
s1.[F2].Resize(UBound(b)) = cc
MsgBox "İşlem tamam.", vbInformation
End Sub

 

[igultekin2000]

Elinize sağlık, çok teşekkür ederim, sorunsuz çalışıyor.