Mükerrer olan satırlar daki farkı bir hücreye yazdırma.

mustilem23

Altın Üye
Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Altın Üyelik Bitiş Tarihi
31-05-2024
Merhaba ,

Elimde 7500 satırlı bir excel mevcut buradaki amacım aynı envanter nosu ile kaç tip makineye malzeme satılmış ve satılanları her bir envanter için tek bir satırda gösterebilmek için yardımcı olabilir misiniz.

Ekte verilerim sayfa 1 de Örnek dosyamda Sayfa 2 de ulaşmak istediğim sonucu göstermeye çalıştım.

yardımcı olabilir misiniz ,Teşekkürler.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Kod:
Sub envanter()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = s1.Cells(Rows.Count, "C").End(3).Row
For i = 2 To son
    If WorksheetFunction.CountIfs(s1.Range("C1:C" & i), s1.Cells(i, "C"), s1.Range("N1:N" & i), s1.Cells(i, "N")) = 1 Then
        yeni = s2.Cells(Rows.Count, "C").End(3).Row + 1
        If WorksheetFunction.CountIf(s2.Range("A1:A" & yeni), s1.Cells(i, "C")) = 0 Then
            s2.Cells(yeni, "A") = s1.Cells(i, "C")
            s2.Cells(yeni, "B") = s1.Cells(i, "D")
            s2.Cells(yeni, "C") = s1.Cells(i, "N")
        Else
            sıra = WorksheetFunction.Match(s1.Cells(i, "C"), s2.Range("A1:A" & yeni), 0)
            s2.Cells(sıra, "C") = s2.Cells(sıra, "C") & ";" & s1.Cells(i, "N")
        End If
    End If
Next
End Sub
 

mustilem23

Altın Üye
Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Altın Üyelik Bitiş Tarihi
31-05-2024
Sayın yusuf44 emeğinize sağlık çok teşekkür ederim ,büyük bir yükten kurtuldum.
 
Üst