• DİKKAT

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

Değişik Sayfalardaki Verileri Özet Sayfada Gösterme

A

akmes

Katılım
27 Mayıs 2010
Mesajlar
527
Excel Vers. ve Dili
Excel 2003 Turkçe
Merhabalar;Ektede anlaşılacağı gibi.Excel dosyasında özet bir sayfamız var.Yıl olarak açtığımız sayfalarda aynı veya o yıl yeni eklenen tüm müşterileri alt altta gelecek şekilde yıl bazında özet sayfasında aktarıp karşılaştırma yapıyoruz.Özet sayfasına ismi yazıyoruz diğer yıllardaki yapmış olduğu satışları bakarak karşısına gelecek şekilde yazıyoruz bu bizim çok zamanımızı alıyor.Bu konuda yardımınızı rica ediyoruz.İlginiz için şimdiden teşekkür ederiz.
 

Ekli dosyalar

yanıt

Kod: 
Sub aktar()
Dim sat As Integer
Dim sut As Byte
Dim sati As Integer
s = 1
Sayfa1.[IV1:IV50000].Clear
Sayfa1.[A3:Q50000].Clear
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "a").End(xlUp).Row
    Sayfa1.Cells(s, "IV") = Sheets(i).Cells(sat, "a") & "  " & Sheets(i).Cells(sat, "b")
    s = s + 1
Next: Next
'
For sat = 1 To Sayfa1.Cells(65536, "IV").End(xlUp).Row
    If WorksheetFunction.CountIf(Sayfa1.Range("IV1:IV" & sat), Sayfa1.Cells(sat, "IV")) > 1 Then
    Sayfa1.Cells(sat, "IV").Delete shift:=xlUp
    End If
Next
'
For sat = 1 To Sayfa1.Cells(65536, "IV").End(xlUp).Row
    Sayfa1.Cells(sat + 2, "a") = Split(Sayfa1.Cells(sat, "IV"), "  ")(0)
    Sayfa1.Cells(sat + 2, "b") = Split(Sayfa1.Cells(sat, "IV"), "  ")(1)
Next
'
For sut = 3 To 50
For i = 2 To Sheets.Count
For sat = 3 To Sayfa1.Cells(65536, "a").End(xlUp).Row
For sati = 3 To Sheets(i).Cells(65536, "a").End(xlUp).Row
    If Sayfa1.Cells(sat, "a") = Sheets(i).Cells(sati, "a") And _
    Sayfa1.Cells(sat, "b") = Sheets(i).Cells(sati, "b") _
     And Sayfa1.Cells(1, sut) Like Sheets(i).Name Then
    
    Sayfa1.Cells(sat, sut) = Sheets(i).Cells(sati, "c").Value
    End If
Next: Next: Next: Next
Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

Üstadım emeğinize sağlık ama Özet sayfasına aynı isimde olanları birden fazla atmış. Örnek Ali adında olandan B4,B11 ve B16 da olmak üzere üç kez atılmış bunu nasıl engelleyebiliriz.
 
Üstadım bu makroyu çalıştırdığımda her sayfada çok fazla veri olduğu için aktarırken excel kilitleniyor.Başka alternatif bir yolu yokmudur?
 
yanıt

Gerekli düzeltme yapılmıştır.Hız konusuna gelince Arkadaşlar alternatif çözüm sunabilirler.
Kod: 
Sub aktar()
Dim sat As Integer
Dim sut As Byte
Dim sati As Integer
s = 1
Sayfa1.[IV1:IV50000].Clear
Sayfa1.[A3:Q50000].Clear
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
For sat = 3 To Sheets(i).Cells(65536, "a").End(xlUp).Row
    Sayfa1.Cells(s, "IV") = Sheets(i).Cells(sat, "a") & "  " & Sheets(i).Cells(sat, "b")
    s = s + 1
Next: Next
'
For sat = Sayfa1.Cells(65536, "IV").End(xlUp).Row To 1 Step -1
    If WorksheetFunction.CountIf(Sayfa1.Range("IV1:IV" & sat), Sayfa1.Cells(sat, "IV")) > 1 Then
    Sayfa1.Cells(sat, "IV").Delete shift:=xlUp
    End If
Next
'
For sat = 1 To Sayfa1.Cells(65536, "IV").End(xlUp).Row
    Sayfa1.Cells(sat + 2, "a") = Split(Sayfa1.Cells(sat, "IV"), "  ")(0)
    Sayfa1.Cells(sat + 2, "b") = Split(Sayfa1.Cells(sat, "IV"), "  ")(1)
Next
'
For sut = 3 To 50
For i = 2 To Sheets.Count
For sat = 3 To Sayfa1.Cells(65536, "a").End(xlUp).Row
For sati = 3 To Sheets(i).Cells(65536, "a").End(xlUp).Row
    If Sayfa1.Cells(sat, "a") = Sheets(i).Cells(sati, "a") And _
    Sayfa1.Cells(sat, "b") = Sheets(i).Cells(sati, "b") _
     And Sayfa1.Cells(1, sut) Like Sheets(i).Name Then
    
    Sayfa1.Cells(sat, sut) = Sheets(i).Cells(sati, "c").Value
    End If
Next: Next: Next: Next
Application.ScreenUpdating = True
End Sub
 
akmes' Alıntı:
Üstadım bu makroyu çalıştırdığımda her sayfada çok fazla veri olduğu için aktarırken excel kilitleniyor.Başka alternatif bir yolu yokmudur?
Genişletmek için tıkla ...

Birde bunu deneyiniz.
Bundan daha hızlı yapılabileceğini sanmıyorum.:cool:
Kod: 
Option Base 1
Sub aktar_59()
Dim liste(), n As Long, sh As Worksheet, sut As Integer
Dim z As Object, myarr(), ilk As Date, sat As Long
Dim i  As Long
Sheets("Özet").Select
ilk = Now
Application.ScreenUpdating = False
Range("A3:IV65536").ClearContents
Range("C1:IV1").ClearContents
sut = 3
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To Worksheets.Count - 1 + 2, 1 To 65536 * Worksheets.Count - 1)
For Each sh In Worksheets
    If sh.Name <> "Özet" Then
        sat = sh.Cells(65536, "A").End(xlUp).Row
        Cells(1, sut).Value = sh.Name
        If sat > 2 Then
            liste = sh.Range("A3:C" & sat).Value
            For i = 1 To UBound(liste, 1)
                If Not z.exists(liste(i, 1)) Then
                    n = n + 1
                    z.Add liste(i, 1), n
                    myarr(1, n) = liste(i, 1)
                    myarr(2, n) = liste(i, 2)
                End If
                myarr(sut, z.Item(liste(i, 1))) = _
                myarr(sut, z.Item(liste(i, 1))) + liste(i, 3)
            Next i
            Erase liste
        End If
        sut = sut + 1
    End If
Next sh
If n > 1 Then
    ReDim Preserve myarr(1 To sut - 1, 1 To n)
    Range("A3").Resize(n, UBound(myarr, 1)) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "İşlem tamam" & vbLf & "Süre : " & _
    Format(Now - ilk, "hh:mm:ss") & vbLf & "evrengizlen@hotmail.com"
End If
Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

Evren Hocam süperr hızlı:) ben sizede Ziya Hocamada çok teşekkür ederim.Kolay gelsin.
 
Hocam birşey fark ettim.Verileri başka programdan rapor aldığım için yıllar arasın da bazı firma isimlerinde "İ" karakterleri "I" olarak değişimiş Örnek ALi iken ALI olmuş böyle olunca arada mükerrer kayıt oluyo.Sizin Makroyu A sütünundaki cari kodlarına göre çalıştırabilirmiyiz?Sizide çok yoruyorum ama makronun neresini değiştireceğimi bilemedim.
 
akmes' Alıntı:
Hocam birşey fark ettim.Verileri başka programdan rapor aldığım için yıllar arasın da bazı firma isimlerinde "İ" karakterleri "I" olarak değişimiş Örnek ALi iken ALI olmuş böyle olunca arada mükerrer kayıt oluyo.Sizin Makroyu A sütünundaki cari kodlarına göre çalıştırabilirmiyiz?Sizide çok yoruyorum ama makronun neresini değiştireceğimi bilemedim.
Genişletmek için tıkla ...

akmes' Alıntı:
Evren Hocam süperr hızlı ben sizede Ziya Hocamada çok teşekkür ederim.Kolay gelsin..
Genişletmek için tıkla ...

Kod numarasına göre düzenledim.Dosyayı önceki mesajdan indirebilirsiniz.
Hızlı derken ne kadar sürede bitiriyor çalışmasını?:cool:
 
Evren Bey,
Benimde Benzer bir dosyada kullanmak istediğim kodlar da
Out of memory (Error 7) hatası alıyorum. 13 sayfaya kadar sorun yok gerçekten hızlı ancak bendeki sayfalar en az 30 memoriye alınan bilgiler geçici bir sayfaya alınabilirmi?
Teşekkürler...
 
akmes' Alıntı:
Merhabalar;Ektede anlaşılacağı gibi.Excel dosyasında özet bir sayfamız var.Yıl olarak açtığımız sayfalarda aynı veya o yıl yeni eklenen tüm müşterileri alt altta gelecek şekilde yıl bazında özet sayfasında aktarıp karşılaştırma yapıyoruz.Özet sayfasına ismi yazıyoruz diğer yıllardaki yapmış olduğu satışları bakarak karşısına gelecek şekilde yazıyoruz bu bizim çok zamanımızı alıyor.Bu konuda yardımınızı rica ediyoruz.İlginiz için şimdiden teşekkür ederiz.
Genişletmek için tıkla ...

.

Bu da Makrosuz Özet tablo ile...

Gerektiği takdirde dinamik hale getirilebilinir.

.
 

Ekli dosyalar

Valla hocam 1 saniye gibi bir zamanda hallediyor.İnanınki çok işime yaradı saatlerimi alıyordu bu iş,
çok makbule geçti.Tekrar çok teşekkür ederim.Kolay gelsin.
 
Valla hocam bir saniye gibi kısa bir zamanda bitiriyor.Oysaki bu iş benim saatlerimi alıyordu.İşimi çok kolaylaştırdınız.Tekrar çok teşekkür ederim.
 
akmes' Alıntı:
Valla hocam bir saniye gibi kısa bir zamanda bitiriyor.Oysaki bu iş benim saatlerimi alıyordu.İşimi çok kolaylaştırdınız.Tekrar çok teşekkür ederim.
Genişletmek için tıkla ...


Rica ederim.
İyi çalışmalar.:cool:
 
usta07' Alıntı:
Evren Bey,
Benimde Benzer bir dosyada kullanmak istediğim kodlar da
Out of memory (Error 7) hatası alıyorum. 13 sayfaya kadar sorun yok gerçekten hızlı ancak bendeki sayfalar en az 30 memoriye alınan bilgiler geçici bir sayfaya alınabilirmi?
Teşekkürler...
Genişletmek için tıkla ...
Önce sayfalardaki benzersiz verileri atıp sonra sayfa sayfa deiğişkenleri atabiliriz.2 saat sonra bakarız.
 
Evren Bey,
Örnek dosya ekledim aslında sayfalardaki alanlar sabit aynı veriler 4 ayrı sutunda ve değişken.
kısaca her hafta için bir sayfa özette de haftaların özeti ama 4 grup için olursa iyi olur olmazsa da canın sağolsun sizden çok şey öğrendik şu mübarek gün helal edin lutfen.
 

Ekli dosyalar

Prensip olarak VBA projelerini ilk anda Şifreleyerek yollayanların dosyalarına bakmıyorum bir daha.Sizinkide vba şifreli.
Başka arkadaştan yardım alınız.:cool:
 
Çok özür dilerim hiç farkında değilim şifrelenecek hiç bir bilgi de yok bakabilirsiniz "muhterem"
 
Selamlar,

Sizin sorunuz için makro kullanmaya gerek yok. Formüllerlede rahatlıkla verileri sayfalardan alabilirsiniz.

Özet isimli sayfanızın C3 hücresine aşağıdaki formülü uygulayın. Formülü diğer hücrelere sürükleyin.

Kod: 
=İNDİS(DOLAYLI("'"&C$1&"'!A2:E65536");KAÇINCI($B3;DOLAYLI("'"&C$1&"'!A2:A65536");0);KAÇINCI(ARA(YİNELE("z";255);$A$3:$A3);DOLAYLI("'"&C$1&"'!2:2");0))
 
Korhan Ayhan' Alıntı:
Selamlar,

Sizin sorunuz için makro kullanmaya gerek yok. Formüllerlede rahatlıkla verileri sayfalardan alabilirsiniz.

Özet isimli sayfanızın C3 hücresine aşağıdaki formülü uygulayın. Formülü diğer hücrelere sürükleyin.

Kod: 
=İNDİS(DOLAYLI("'"&C$1&"'!A2:E65536");KAÇINCI($B3;DOLAYLI("'"&C$1&"'!A2:A65536");0);KAÇINCI(ARA(YİNELE("z";255);$A$3:$A3);DOLAYLI("'"&C$1&"'!2:2");0))
Genişletmek için tıkla ...

Korhan Bey,
Tek kelime ile Harika bir çözüm.
Çok Teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst