Veri saydırma raporu

[EmrExcel16]

Merhaba arkadaşlar ektede anlatmaya çalıştığım A:B sutunundaki verilerimin bir kod yardımıyla hızlı bir şekilde saydırmak istiyorum yapmaya çalıştım ama işin içinden çıkamadım ilğilenen arkadaşlar için ekteki dosyadada ne yapmak istediğimi anlattım yardımlarınız için şimdiden teşekkür ederim
iyi çalışmalar..

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub topla59()
Dim z As Object, i As Long, liste(), myarr(), sat As Long
Dim deg As String, sat2 As Long
Range("H2:N" & Rows.Count).ClearContents
sat = Cells(Rows.Count, "A").End(xlUp).Row
liste = Range("A2:B" & sat).Value
Set z = CreateObject("Scripting.dictionary")
ReDim myarr(1 To 3, 1 To sat)
sat = UBound(liste)
For i = 1 To sat
    deg = liste(i, 1) & liste(i, 2)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = liste(i, 1)
        myarr(2, n) = liste(i, 2)
    End If
    myarr(3, z.Item(deg)) = myarr(3, z.Item(deg)) + 1
Next i
Erase liste: Set z = Nothing
ReDim Preserve myarr(1 To 3, 1 To n)
Application.ScreenUpdating = False
If n > 0 Then Range("H2").Resize(n, 3) = Application.Transpose(myarr)
sat2 = Int(n \ 2) + 2
Range("H" & sat2 & ":J" & n + 1).Cut
Range("L2").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
        vbOKOnly + vbInformation, Application.UserName
MsgBox n
End Sub

 

[EmrExcel16]

Hocam mükemmelin üstünde teşekkür ederim harika olmuş emeğinize sağlık .Bu rapordan çıktı aldığımda sayfanın yarısı boş kalıyor çıkan raporun yarısını yandaki hücreye L:M:N hücresine bölmemiz mümkünmü acaba diyelimki butona bastığımda 152 malzeme çıktı bunun altan 76 sını yandaki hücreye kaydırsın böylelikle sayfa sayısı azalmış olur yada farklı öneriniz varsa uygulayabilirim benim için önemli olan rapor çıktısını aldığımda sayfa sayısını en aza indirip israftan kurtulmuş olurum.Bu arada kusuruma bakmayın bunu başta söylemediğim için.

 

[Orion1]

Öyle olursa kod yavaşlayabilir.Siz onu kesip yapıştırın listeden isterseniz.

 

[EmrExcel16]

Anladım hocam dosyayı ortak kullanıma açmak istiyodum herkes rapor çıktısı alabilsin diye exceli bilmeyen arkadaşlar bile olsa sadece butona basıp çıktıyı alabilirler diye düşünmüştüm amacım kağıt israfını engellemekdi ama olmuyacak sanırım çünkü ben yaparım ama diğer giren arkadaşlar bunu yapmayı düşünmeyebilirler aslında çok yavaşlamıyacaksa sorun olmaz ama siz daha iyi bilirsiniz çünkü yaptığınız kod istediğimden dahada hızlı olmuş.
Eğer bu şekilde olmuyacaksada herşey için teşekkür ederim hocam sağolun.

 

[Orion1]

Anladım hocam dosyayı ortak kullanıma açmak istiyodum herkes rapor çıktısı alabilsin diye exceli bilmeyen arkadaşlar bile olsa sadece butona basıp çıktıyı alabilirler diye düşünmüştüm amacım kağıt israfını engellemekdi ama olmuyacak sanırım çünkü ben yaparım ama diğer giren arkadaşlar bunu yapmayı düşünmeyebilirler aslında çok yavaşlamıyacaksa sorun olmaz ama siz daha iyi bilirsiniz çünkü yaptığınız kod istediğimden dahada hızlı olmuş.
Eğer bu şekilde olmuyacaksada herşey için teşekkür ederim hocam sağolun.

Dosyayı 2 nolu mesajda güncelledim.
Ben pek kontrol etmedim.
Siz önce kontrol ediniz.Hepsi listelenmişmidir diye.

 

[EmrExcel16]

Hocam teşekkür ederim elinize sağlık mükemmel oldu
kolay gelsin