Soru listede benzer olmayanları aktarma

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
Sorunuzun bu şekliyle çalışır, tekrar eden yeni veya eski fatura varsa yanlış sonuç verecektir. Benden bu kadar.
Kod:
Option Explicit
Sub test()

    Dim sonE As Long, sonY As Long, i As Long, al

    sonE = Cells(Rows.Count, "N").End(3).Row
    sonY = Cells(Rows.Count, "Z").End(3).Row

    Range("A5:L" & Rows.Count).ClearContents

    With Range("N5:X" & sonE & ",Z5:AJ" & sonY)
        .Font.ColorIndex = xlAutomatic
        .Font.Bold = False
        .Interior.ColorIndex = xlAutomatic
    End With

    With CreateObject("Scripting.Dictionary")
        
        For i = 5 To sonY
            al = Join(Application.Index(Cells(i, "Z").Resize(, 11).Value, 0), "|")
            .Add al, i
        Next i

        For i = 5 To sonE
            al = Join(Application.Index(Cells(i, "N").Resize(, 11).Value, 0), "|")
            If .exists(al) Then
                With Union(Cells(.Item(al), "Z").Resize(, 11), Cells(i, "N").Resize(, 11))
                    .Font.Color = vbRed
                    .Font.Bold = True
                    .Interior.Color = vbYellow
                End With
                .Remove al
            End If
        Next i
        
        If .Count > 0 Then
            i = 5
            For Each al In .items
                Cells(al, "Z").Resize(, 11).Copy Cells(i, "A")
                i = i + 1
            Next
        End If
        
    End With
End Sub
 

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
Sayın veysel bey
gerçekten güzel olmuş.yardımınız için teşekkür ederim.
yeni listeye haftalık olarak ekleme yapıyorum.eski listede ve yeni listede benzer ft oluyor.onları birbirinden ayırıp yeni bir liste yapmak istiyorum.
aynı ft lar olmadığında gayet güzel aktarıyor.ancak benzer ft lar olunca sorun çıkıyor.

nasıl çözeriz.

iyi çalışmalar
 

Ekli dosyalar

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
arkadaşlar günaydın bu konuda yardım edebilecekmisiniz ?
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Nadir bey merhaba,

Size alternatif bir dosya hazırladım.
Bu mantık ile gitmeniz kodlama ve raporlamada daha rahat çalışılmasını sağlayacaktır.
 

Ekli dosyalar

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
SAYIN erdem öncelikle çözüm öneriniz için teşekkür ediyorum.

sizin gönderdiğiniz örnekte gayet güzel bir çözüm
ancak benim örnek dosyamda birçok sekme var yeni faturaları bu sekmelere makro ile aktarıp kontrol tablosu oluşturmak istiyorum.
sizin gönderdiğiniz dosya hem fazladan sekme hemde eski yeni faturaları süz aktar gibi ilaveler çıkacak.bu dosyayı benim dışımda başkalarıda kullanacak çok sekme olunca hata yapma olasılığı artacak bu sebeple ekte örnek dosya ekliyorum.bunun üzerinden çalışma yapabilirsek çok daha verimli ve pratik olacak.sorumda ilk gönderdiğim dosyayı ekliyorum.bunun için çözüm üretebilirsek memnun olacağım.daha sonra gönderdiğim örnek dosyalar üzerinden çözüm üretebilirmiyiz. diye örnek dosya eklemiştim.benim ilk gönderdiğim dosya üzerinden çalışma yaparsak.aşağıda ekteki dosyam sorunum çözülmüş olacak.buradaki mantık eski ft listesi ve yeni ft listesi karşılaştırıp aynı olanları sarı kırmızıya boyamak aynı olmayan ft renklendirmeyerek işlenmemiş ft listesine aktarması.bu listeyi ben daha sonra diğer sekmelere aktaracağım.

iyi çalışmalar
 

Ekli dosyalar

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Ben alternatif bir çözüm sunmak istedim. İsterseniz sadece işlenmeyen kayıtları da görebilirsiniz. Kodu altındaki kısmı silmeniz yeterli olur.
Size kolaylıklar dilerim.
 

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
ilginize teşekkür ederim.
dosyam üzerinden çözüm alabilirsem daha memnun olacağım

iyi çalışmalar
 

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
arkadaşlar bu konuda yardım edecek bir üstat varmı acaba ?
değişik çözüm önerisi olanlar oldu ancak tam olarak benim sorunuma çözüm olmadı.
benim için önemli bir konu
 

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
arkadaşlar günaydın
bu sorumla ilgili birçok kez yazdım ancak istediğim sonucu maalesef alamadım.
bugüne kadar soru sorup cevap alamadığım olmadı.herkese ayrı ayrı teşekkür ederim.
ancak bu sorunun çözümüyle ilgili cevap veren arkadaşlar olmasına rağmen benim istediğim gibi bir sonuç alamadım.
benim için önemli bir konu ve aciliyeti var.
zor ve uğraştırıcı zaman alıcı bir çalışma diyorsanız.
bu konuda yardımcı olacak arkadaşlarlada görüşmek isterim.
buradaki üstatlardan bu konuda yardım etmelerini rica ediyorum.
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Yapmak istediğiniz;
" İŞLENEN FATURA" fatura sayfasındaki Yeni faturalar ile Eski faturalar bölümünü karşılaştırıp benzer olmayanları İşlenmemiş faturalar bölümüne aktarmak mı?
 

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
Merhaba

evet Ömer bey
veysel bey buraya kadar olan kısmı yaptı.ancak eski listede aynı fatura numarası olanlar faturalar olunca sorun çıkıyor.
burayı nasıl çözebiliriz ömer bey.bu dosyam üzerinde çalışma yaparsanız memnun olurum
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Detaylı incelemedim.
Veysel Bey'in kodlarını bu şekilde kullanırsanız istediğiniz sonucu veriyor mu?
Kod:
Private Sub CommandButton1_Click()

    Dim sonE As Long, sonY As Long, i As Long, al

    sonE = Cells(Rows.Count, "N").End(3).Row
    sonY = Cells(Rows.Count, "Z").End(3).Row

    Range("A5:L" & Rows.Count).ClearContents

    With Range("N5:X" & sonE & ",Z5:AJ" & sonY)
        .Font.ColorIndex = xlAutomatic
        .Font.Bold = False
        .Interior.ColorIndex = xlAutomatic
    End With

    With CreateObject("Scripting.Dictionary")
        
        For i = 5 To sonY
            al = Join(Application.Index(Cells(i, "Z").Resize(, 11).Value, 0), "|")
            If Not .exists(al) Then
                .Add al, i
            End If
        Next i

        For i = 5 To sonE
            al = Join(Application.Index(Cells(i, "N").Resize(, 11).Value, 0), "|")
            If .exists(al) Then
                With Union(Cells(.Item(al), "Z").Resize(, 11), Cells(i, "N").Resize(, 11))
                    .Font.Color = vbRed
                    .Font.Bold = True
                    .Interior.Color = vbYellow
                End With
                .Remove al
            End If
        Next i
        
        If .Count > 0 Then
            i = 5
            For Each al In .items
                Cells(al, "Z").Resize(, 11).Copy Cells(i, "A")
                i = i + 1
            Next
        End If
        
    End With
End Sub
 

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,264
Excel Vers. ve Dili
2016 Türkçe
Ömer bey çok teşekkür ederim
sonunda sorunumu çözdünüz

iyi çalışmalar
 
Üst