Tutarları eşleşenleri aktarma

[NADİR YILDIZ]

arkadaşlar ekteki dosyamda açıklama yaptığım şekilde çözüme yardımcı olurmusunuz

 

[NADİR YILDIZ]

arkadaşlar bu konuda yardımcı olabilirmisiniz

 

[NADİR YILDIZ]

bu konuda bilgisi olan var mı

 

[ÖmerFaruk]

K sütunundaki sayıların hangilerinin J için aranacağına dair kıstas belirtmeniz lazım.
Tabloya bakıldığında herhangi bir sağlıklı kıstas göremedim.

Örneğin şu bir kıstas mıdır?
J6 da baktığımız değer için
bir alt satırında K7 den başlayıp K10 a kadr devam eden dolu K satırlarının ardışık toplamlarından (K7 / K7+K8 / K7+K8+K9 gibi) herhangi biri J6 yı veriyorsa bu K değerleri J6 için doğrudur deyip EŞLEŞENLER sayfasına aktarılacak.

Mesela K7-K8-K9 eşleşti ve 6-7-8-9 satılarını eşleşenlere aktardık.
10.satırda tek kalan K sütunundan dolayı bunu FARKLAR kısmına mı aktaracağız?
Yoksa J sütunundaki ilk dolu değer olan J11 için mi kontrol edeceğiz?

 

[NADİR YILDIZ]

Sayın nextlevel öncelikle cevap verdiğiniz için çok teşekkür ediyorum.

burada yapmak istediğim J sütunundaki sayıları karşılayacak parçalı sayıları K sütunundaki ile eşleştirmesi
J6 daki tutar 1.617,46 TL bu tutarın toplamı olan K7:K:8:K9:K9=636,50+194,65+213,25+573,06= 1.617,46 TL ile eşleştiği için eşleşenler sayfasına aktarması.bu tür eşleşenleri kırmızı ile işaretleyerek eşleşenler sayfasında örneklendirdim.

eşleşmeyenleri ise fark sayfasına aktarmak
J11 deki tutar 7,50 TL bunun K sütununda 7,5 TL yada 7,5 TL yi karşılık farklı sayılar olmadığı için farklar sayfasına aktarmak.
bu tür eşleşmeyenleride siyah ile işaretleyerek fark sayfasında örneklendirdim.

yani kısacası J sütunundaki sayıyı karşılayacak parçalı olan tutarları eşleşenlere aktarmak.olmayanları farklar sayfasına aktarmak istiyorum.

bütün kriter J ve K sütununa göre yapılacak diğer sütunlarda eşleşme yapacak bir durum yok zaten her bilgi birbirinden farklı

iyi çalışmalar

 

[ÖmerFaruk]

Siz yine de bir önceki mesajımı bir daha okuyun.
Kıstas olmayınca iş kompinasyonlara kalır ve öyle bir kod yazmasına yazılır da bilgisayarınız kadırır mı bilemem

 

[NADİR YILDIZ]

Sayın nextlevel 10.satır boş kalmıyor 1617,46 karşılığı K 7-8-9-10 satırlar oluyor zaten
ayrı ayrı renklendirdim.

kıstas belli J sütunundaki tutarı karşılayacak parçalı sayılar K sütununda var. 1617,46 karşılıyacak tutarlar K sütununda parça parça verilmiş renklendirdim.bunları dışında J sütunundaki tutarı karşılayan sayılar K sütununda yoksa farklar sayfasına aktarıyor.
sorularımda hep aynı şeyi anlattım.

kıstas J nin toplamı sayılar k sütununda varmı yokmu hepsi bu kadar

iyi çalışmalar

 

[ÖmerFaruk]

Anlatamadım.
Umarım çözüm için yardımcı olan çıkacaktır. Kolay gelsin.

 

[NADİR YILDIZ]

bende anlatamadım
umarım çözüme yardım olan biri çıkar.kolay gelsin

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Eslesen_Eslesmeyen_Kayitlari_Aktar()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, WF As WorksheetFunction
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Topla As Double, Alan As Range
    
    Zaman = Timer
    
    Set S1 = Sheets("LİSTE")
    Set S2 = Sheets("EŞLEŞENLER")
    Set S3 = Sheets("FARKLAR")
    Set WF = WorksheetFunction
    
    S1.Range("N:N").ClearContents
    S2.Range("A6:K" & S2.Rows.Count).Clear
    S3.Range("A6:K" & S3.Rows.Count).Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 6 Then Son = 7
    
    Veri = Range("A6:M" & Son).Value
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 10) <> 0 Then
            For Y = LBound(Veri, 1) To UBound(Veri, 1)
                If Veri(Y, 11) <> 0 Then
                    If S1.Cells(Y + 5, "N") = "" Then
                        Topla = Topla + Veri(Y, 11)
                        If Alan Is Nothing Then
                            Set Alan = S1.Cells(Y + 5, "N")
                        Else
                            Set Alan = Union(Alan, S1.Cells(Y + 5, "N"))
                        End If
                        If WF.Round(Topla, 2) = WF.Round(Veri(X, 10), 2) Then
                            S1.Cells(X + 5, "N") = "E"
                            Alan.Value = "E"
                            Topla = 0
                            Set Alan = Nothing
                            Exit For
                        End If
                    End If
                Else
                    Set Alan = Nothing
                    Topla = 0
                End If
            Next
        End If
    Next
    
    S1.Range("A5:N" & S1.Rows.Count).AutoFilter 14, "E"
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son > 5 Then S1.Range("A5:K" & Son).Copy S2.Range("A5")
    
    S1.Range("A5:N" & S1.Rows.Count).AutoFilter 14, ""
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son > 5 Then S1.Range("A5:K" & Son).Copy S3.Range("A5")
    
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
    
    S1.Range("N:N").ClearContents
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set WF = Nothing
    
    MsgBox "Eşleşen ve eşleşmeyen kayıtlar aktarılmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[NADİR YILDIZ]

Korhan bey teşekkür ediyorum.
her zaman olduğu gibi hızır gibi yetişerek sorunuma çözüm ürettiğiniz için teşekkürler
biz muhasebecilerin en büyük sorunlarından biride 108-hazır değerler hesabındaki ( k.kartlı satışlar ) giriş çıkışlarını tutturmak
bunları eşleştirmek girişi yada çıkışı olmayanların bulunması gibi büyük bir sorunu sayın korhan ayhanın desteği ile çözüme kavuşturmuş olduk.

kullanmış olduğum programa uygulanabilirliği olduğu için pratik oldu.
aynı programı kullanan arkadaşlarında kullanabilmesi için değişik bankalara ait muavin kayıtları ile ilgili örnek dosyaları ekliyorum.
iyi çalışmalar