fatura listesinde malzemeleri birleştirmek

[omermahmud]

Mal alım raporunu örnekteki gibi almaktayım. Indirilecek kdv listesini oluşturabilmek için her faturaya ait malzemeleri yani içerisindeki tüm fatura kalemlerini birleştirmem gerekiyor. Aynı şekilde her malzemeninde adet ve birimini birleştirerek tek bir satıra yazmam gerekiyor. Bu ise çok uzun zaman almaktadır. Indirilecek kdv listesini incelerseniz derdimi daha çabuk anlatabilirim. Bu konuda acaba makro yazabilecek arkadas var mı? Yapacağınız yardımlar için şimdiden teşekkürler...

 

[excel03]

merhaba;

Sub Grupla()
Dim alan As Range
Dim alan2 As Range
Set alan = Worksheets(2).Range("a2:h" & Cells(65536, 1).End(3).Row)
Set alan2 = Worksheets(1).Range("a2:f" & Cells(65536, 1).End(3).Row)
Worksheets(2).Select
alan2.Cells.ClearContents
alan.Cells.Font.Color = vbBlack
For i = 1 To alan.Columns(3).Rows.Count
alan.Columns(3).Rows(i).Font.Bold = True
tar = (alan.Columns(1).Rows(i))
FatNo = alan.Columns(2).Rows(i)
temp = alan.Columns(3).Rows(i)
MalAdı = alan.Columns(5).Rows(i)
z = MalAdı
Miktar = alan.Columns(7).Rows(i) & " " & alan.Columns(8).Rows(i).Value
Tutar = alan.Columns(6).Rows(i)


        For j = 1 To alan.Columns(3).Rows.Count
        ss = alan.Columns(3).Rows(j).Value
        If alan.Columns(3).Rows(j).Value = temp And _
        alan.Columns(3).Rows(j).Font.Bold = False And _
        alan.Columns(3).Rows(j).Font.Color <> vbRed Then
        
        MalAdı = MalAdı & "," & alan.Columns(5).Rows(j).Value
        Tutar = Tutar + alan.Columns(6).Rows(j).Value
        Miktar = Miktar & "," & alan.Columns(7).Rows(j).Value & " " & alan.Columns(8).Rows(j).Value
        
        alan2.Columns(1).Rows(i).Value = tar
        alan2.Columns(2).Rows(i).Value = FatNo
        alan2.Columns(3).Rows(i).Value = temp
        alan2.Columns(4).Rows(i).Value = MalAdı
        alan2.Columns(5).Rows(i).Value = Miktar
        alan2.Columns(6).Rows(i).Value = Tutar
        alan.Columns(3).Rows(j).Font.Color = vbRed
        End If
        
        Next j
        
    If z = MalAdı And alan.Columns(3).Rows(i).Font.Color <> vbRed Then
    alan2.Columns(1).Rows(i).Value = tar
    alan2.Columns(2).Rows(i).Value = FatNo
    alan2.Columns(3).Rows(i).Value = temp
    alan2.Columns(4).Rows(i).Value = MalAdı
    alan2.Columns(5).Rows(i).Value = Miktar
    alan2.Columns(6).Rows(i).Value = Tutar
    End If
    
    
    alan.Columns(3).Rows(i).Font.Bold = False
    alan.Columns(3).Rows(i).Font.Color = vbRed

Next i
alan.Columns(3).Font.Color = vbBlack
alan2.Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
alan2.Rows.EntireRow.AutoFit
End Sub

 

[omermahmud]

İlginiz ve yardımınız için çok teşekkür ederim. Yalnız satıcıya göre sıralama yapıyor. Yani aynı satıcıya ait faturaları tek bir fatura olarak birleştiriyor. Benim istediğim ise fatura fatura olması. Sıralamada ölçütün belge numarası (B sütünunun) olması gerekmektedir. Her bir faturayı ayrı ayrı getirmesi gerekmektedir.

 

[excel03]

merhaba;gönderdiğiniz örnek dosyanın 1. çalışma sayfasında sunulan örneği; yazılan makro yapıyor.
İsteğinizi tam anlayamamakla birlikte verilerin belge no'ya (Fatura No'ya) göre sıralanması gerekli ise,verilen makronun şu kısmına aşağıdaki kodu yapıştırınız.

.............
.............
alan2.Cells.ClearContents
alan.Cells.Font.Color = vbBlack
Range(alan.Cells.Address).Sort Range("b2") '<< Bu kodu ilave ediniz.
For i = 1 To alan.Columns(3).Rows.Count
alan.Columns(3).Rows(i).Font.Bold = True
tar = (alan.Columns(1).Rows(i))
...........
...........

 

[omermahmud]

Herşey için teşekkür ederim. Belge No sütünu ile Satıcı Adı sütünunu değiştirdim sorun halloldu. Örnek dosya ektedir.