aynı satırları tek sutunda birleştirme

[bekirk1981]

Arkadaşlar Merhaba;
satış faturalarım adı altında bir dosyam var, burada satış faturaları listesi içersinde bulunan satırların ,birleştirilenler kısmına tek satırda yazdırılmasını istiyoruz. Fkat bir türlü yapamadık, yardımcı olabilirmisiniz ?

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu Fatura Listesi adlı sayfanın kod sayfasına kopyalayıp çalıştırın.

Sub test()
    Dim Bak As Long, Sira As Long
    Dim Cins As String, Miktar As String
    
    For Bak = 5 To Cells(Rows.Count, "A").End(xlUp).Row
        Do
            If Cins = "" Then
                Cins = Cells(Bak, "C")
                Miktar = Cells(Bak, "D")
            Else
                Cins = Cins & ", " & Cells(Bak, "C")
                Miktar = Miktar & ", " & Cells(Bak, "D")
            End If
            
            If Cells(Bak, "A") <> Cells(Bak + 1, "A") Then
                Exit Do
            End If
            Bak = Bak + 1
        Loop
        With Worksheets("Birleştirilenler")
            Sira = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Cells(Sira, "A") = Cells(Bak, "A")
            .Cells(Sira, "B") = Cells(Bak, "B")
            .Cells(Sira, "C") = Cins
            .Cells(Sira, "D") = Miktar
            .Cells(Sira, "E") = Cells(Bak, "E")
            .Cells(Sira, "F") = Cells(Bak, "F")
            .Cells(Sira, "G") = Cells(Bak, "G")
            .Cells(Sira, "H") = Cells(Bak, "H")
            .Cells(Sira, "I") = Cells(Bak, "I")
        End With
        
        Cins = ""
        Miktar = ""
    Next
    
    MsgBox "Tamamlandı.", vbInformation
End Sub

 

[bekirk1981]

merhaba;
kod sayfası dediğiniz yer ? neresi

 

[Muzaffer Ali]

"Satış Faturaları Listesi" sayfa sekme adını sağ tıklatın, kod görüntüle seçin, açılan sayfaya kodları kopyalayın.
Kodların herhangi bir satırı seçiliyken F5 tuşuna basarak kodları çalıştırın.

 

[bekirk1981]

teşekkür ederim, fakat satırları incelediğimizde bazı satırlarda atlama yaptığı gözükmektedir.

 

[bekirk1981]

yani faturasının sıra nosu ile ihraç edilen malın cinsi karşılanmamaktadır. farklı karşılıklar gelmektedir.

 

[Muzaffer Ali]

Kodu düzelttim yeniden deneyin.

 

[bekirk1981]

Kodu düzelttim yeniden deneyin.

maalesef gene aynı hocam kusura bakmayın sizi yoruyorum

 

[Muzaffer Ali]

Şimdi yeniden test ettim sonuç doğru çıkıyor.
Siz son değiştirdiğim kodları alıp denediniz değil mi?

 

[bekirk1981]

evet , yeniden denedik teşekkür ederim.