faturadaki grupları toplama

[ERKAN1974]

Arkadaşlar örnek dosya ekte.
her faturanın stok grubunda yazılanları kendi içinde toplatmak istiyorum.

En kolay nasıl yaparım fikirlerinizi paylaşmanızı rica ediyorum.

 

[ERKAN1974]

örnek

örnek dosya ekte

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub aktar()
Dim a, b, i, n, sat, veri()
Set s1 = Sheets("data")
Set s2 = Sheets("özet")
'*******************************************
a = s1.Range("a8:j" & s1.[f65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 10)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> "" Then v01 = a(i, 1)
        If a(i, 1) <> "" Then v02 = a(i, 2)
        If a(i, 1) <> "" Then v03 = a(i, 6)
        
        If a(i, 1) <> "" Then
        z = a(i, 1) & ":" & a(i, 2) & ":" & a(i, 6)
        Else
        z = v01 & ":" & v02 & ":" & a(i, 6)
        End If
        
           If Not IsEmpty(z) Then
                 If Not .exists(z) Then
                    n = n + 1
                    veri(n, 1) = Format(a(i, 1), "dd.mm.yyyy")
                    veri(n, 2) = a(i, 2)
                    veri(n, 3) = a(i, 3)
                    veri(n, 4) = a(i, 4)
                    veri(n, 5) = a(i, 5)
                    veri(n, 6) = a(i, 6)
                    veri(n, 8) = a(i, 8)
                    veri(n, 9) = a(i, 9)
                    veri(n, 10) = a(i, 10)
                     .Add z, n
                  End If
                    veri(.Item(z), 7) = veri(.Item(z), 7) + a(i, 7)
            End If
    Next i
End With
'*******************************************
sat = s2.[f65536].End(3).Row + 1
s2.Range(s2.Cells(7, "a"), s2.Cells(sat, "j")).ClearContents
s2.[a7].Resize(n, 10).Value = veri
''*******************************************
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[ERKAN1974]

Ellerinize sağlık.

Tek problem vergi dairesi hes.no sunun diğer sayfaya geçerken başında sıfır varsa başındaki sıfırların silinmesi.

Yardımlarınız için teşekkür ederim.

 

[Recep İpek]

...Tek problem vergi dairesi hes.no sunun diğer sayfaya geçerken başında sıfır varsa başındaki sıfırların silinmesi.

...

Özet sayfasındaki E kolonunun formatını TEXT olarak değiştirin.

 

[ERKAN1974]

Recep Bey teşekkür ederim.
Makro çok işime yaradı.
Sadece bir ayını günlerce uğraşsam bitiremezdim. Bir ay 30 sn.de bitiyor.

 

[ERKAN1974]

Sütun sayısını 14 e çıkartıp 11. nci sütununda 7. sütun gibi toplanmasını nasıl yapabilirim.

 

[Recep İpek]

Sütun sayısını 14 e çıkartıp 11. nci sütununda 7. sütun gibi toplanmasını nasıl yapabilirim.

Güncellenmiş dosya ektedir.

 

[ERKAN1974]

Ellerinize sağlık Recep Bey.