• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Veri saydırma raporu

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
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..
 
Son düzenleme:
Dosyanız ektedir.:cool:
Kod:
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
 

Ekli dosyalar

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.
 
Öyle olursa kod yavaşlayabilir.Siz onu kesip yapıştırın listeden isterseniz.:cool:
 
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.
 
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.:cool:
 
Hocam teşekkür ederim elinize sağlık mükemmel oldu
kolay gelsin
 
Geri
Üst