• DİKKAT

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

Gelişmiş filtre yardımı

excelience

excelience

Katılım
27 Mayıs 2017
Mesajlar
203
Excel Vers. ve Dili
2021
Merhaba abiler arkadaslar yazimi duzeltiyorum dosya ekledim sorun excel ekinde yaziyor yardimlariniz icin simdiden tesekkurler
1.sayfadan 2.sayfaya makro ile veri transferi yapiyorum fakat
2.sayfada ki verileri 3.sayfaya ekte belirttigim sekilde aktaramiyorum
3.yani 2.sayfada ki veriler 3.sayfaya isin ozeti raporu seklinde aksin istiyorum
 

Ekli dosyalar

Son düzenleme:
Resim yerine dosyanızı eklerseniz yardım almanız kolaylaşır.
 
Merhaba korhan hocam dosya ekledim yardımlarınızı bekliyorum hocam teşekkür ederim şimdiden emekleriniz için
 
Yok mu yardim edebilecek bir baba yigit arkadaslar basit bir örnegi ekte mevcut sizin icin cok basit benim icin cok zor yardimlarinizi bekliyorum simdiden emeginize saglik
 
Sn. excellence, Sayfa2 de herhangi A sütununda herhangi bir veri görünmüyor, bilginize.
 
Merhaba tahsin bey ben onu kendi olusturdugum excele gore yazmistim siz yukledigim dosyayi indirip eke bakarsaniz ne demek istedigimi anlarsiniz. Sorunu icinde belirttim simdiden tesekkur ederim emekleriniz icin
 
Ekli dosyayı inceleyin

isteğiniz doğrultuda bir dosya hazırladım, uzman kardeşlerimiz daha iyisini yapabilirler. Dosyanız ektedir.
 

Ekli dosyalar

Aşağıdaki kodu deneyiniz.

Kod: 
Sub ÖZET_RAPOR()
    Dim S2 As Worksheet, S3 As Worksheet, WF As WorksheetFunction
    Dim Son As Long, X As Long, Satir As Long, Bul As Range
    
    Application.ScreenUpdating = False
    
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Set WF = WorksheetFunction
    
    S3.Range("A2:F" & S3.Rows.Count).Clear
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
    Satir = 2
    
    For X = 5 To Son
        If S2.Cells(X, 2) <> "" Then
            If WF.CountIf(S3.Range("A:A"), S2.Cells(X, 2)) = 0 Then
                S3.Cells(Satir, 1) = S2.Cells(X, 2)
                S3.Cells(Satir, 2) = WF.SumIf(S2.Range("B:B"), S2.Cells(X, 2), S2.Range("D:D"))
                S3.Cells(Satir, 3) = S2.Cells(X, 3)
                S3.Cells(Satir, 4) = WF.SumIfs(S2.Range("D:D"), S2.Range("B:B"), S3.Cells(Satir, 1), S2.Range("C:C"), S3.Cells(Satir, 3))
                S3.Cells(Satir, 5) = WF.SumIfs(S2.Range("E:E"), S2.Range("B:B"), S3.Cells(Satir, 1), S2.Range("C:C"), S3.Cells(Satir, 3))
                S3.Cells(Satir, 6) = S2.Cells(X, 2) & "_" & S2.Cells(X, 3)
                Satir = Satir + 1
            Else
                Set Bul = S3.Range("F:F").Find(S2.Cells(X, 2) & "_" & S2.Cells(X, 3), , , xlWhole)
                If Bul Is Nothing Then
                    Satir = S3.Cells(S3.Rows.Count, 3).End(3).Row + 1
                    S3.Cells(Satir, 3) = S2.Cells(X, 3)
                    S3.Cells(Satir, 4) = WF.SumIfs(S2.Range("D:D"), S2.Range("B:B"), S2.Cells(X, 2), S2.Range("C:C"), S3.Cells(Satir, 3))
                    S3.Cells(Satir, 5) = WF.SumIfs(S2.Range("E:E"), S2.Range("B:B"), S2.Cells(X, 2), S2.Range("C:C"), S3.Cells(Satir, 3))
                    S3.Cells(Satir, 6) = S2.Cells(X, 2) & "_" & S2.Cells(X, 3)
                    Satir = Satir + 1
                End If
            End If
        End If
    Next
    
    S3.Range("F:F").Clear
    S3.Range("A1:E" & Satir - 1).Borders.LineStyle = 1
    S3.Range("A:D").HorizontalAlignment = xlCenter
    S3.Range("E2:E" & Satir - 1).Style = "Currency"
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sn. Korhan hocam mükemmel olmuş ellerinize sağlık, sakin kafayla kodları tek tek irdeliyeceğim :)
 
tahsinanarat' Alıntı:
isteğiniz doğrultuda bir dosya hazırladım, uzman kardeşlerimiz daha iyisini yapabilirler. Dosyanız ektedir.
Genişletmek için tıkla ...


tahsin hocam çalışmanız için teşşekkür ederim . Fakat onu kendi çalışmama nasıl uyarlayacağım çözemedim benim çalışmamı bana düzenleyip yollayabilirmisiniz .
 
korhan ayhan' Alıntı:
aşağıdaki kodu deneyiniz.

Kod: 
sub özet_rapor()
    dim s2 as worksheet, s3 as worksheet, wf as worksheetfunction
    dim son as long, x as long, satir as long, bul as range
    
    application.screenupdating = false
    
    set s2 = sheets("sayfa2")
    set s3 = sheets("sayfa3")
    set wf = worksheetfunction
    
    s3.range("a2:f" & s3.rows.count).clear
    son = s2.cells(s2.rows.count, 2).end(3).row
    satir = 2
    
    for x = 5 to son
        ıf s2.cells(x, 2) <> "" then
            ıf wf.countıf(s3.range("a:a"), s2.cells(x, 2)) = 0 then
                s3.cells(satir, 1) = s2.cells(x, 2)
                s3.cells(satir, 2) = wf.sumıf(s2.range("b:b"), s2.cells(x, 2), s2.range("d:d"))
                s3.cells(satir, 3) = s2.cells(x, 3)
                s3.cells(satir, 4) = wf.sumıfs(s2.range("d:d"), s2.range("b:b"), s3.cells(satir, 1), s2.range("c:c"), s3.cells(satir, 3))
                s3.cells(satir, 5) = wf.sumıfs(s2.range("e:e"), s2.range("b:b"), s3.cells(satir, 1), s2.range("c:c"), s3.cells(satir, 3))
                s3.cells(satir, 6) = s2.cells(x, 2) & "_" & s2.cells(x, 3)
                satir = satir + 1
            else
                set bul = s3.range("f:f").find(s2.cells(x, 2) & "_" & s2.cells(x, 3), , , xlwhole)
                ıf bul ıs nothing then
                    satir = s3.cells(s3.rows.count, 3).end(3).row + 1
                    s3.cells(satir, 3) = s2.cells(x, 3)
                    s3.cells(satir, 4) = wf.sumıfs(s2.range("d:d"), s2.range("b:b"), s2.cells(x, 2), s2.range("c:c"), s3.cells(satir, 3))
                    s3.cells(satir, 5) = wf.sumıfs(s2.range("e:e"), s2.range("b:b"), s2.cells(x, 2), s2.range("c:c"), s3.cells(satir, 3))
                    s3.cells(satir, 6) = s2.cells(x, 2) & "_" & s2.cells(x, 3)
                    satir = satir + 1
                end ıf
            end ıf
        end ıf
    next
    
    s3.range("f:f").clear
    s3.range("a1:e" & satir - 1).borders.linestyle = 1
    s3.range("a:d").horizontalalignment = xlcenter
    s3.range("e2:e" & satir - 1).style = "currency"
    
    application.screenupdating = true
    
    msgbox "işleminiz tamamlanmıştır.", vbınformation
end sub
Genişletmek için tıkla ...



merhaba korhan hocam emeğinize sağlık bu kodları nerey ekleyecegim bilmiyorum bu konuda cahilim affınıza sıgınıyorum gelistirici sekmesinden visual basic koda girip sayfa3 e yapıstırdım .islem tamamlandı diyip olumlu sonucu aldım fakat daha sonra excel komple hata verdi :) direk yolladıgım ektekik dosyayı duzenleyip yollama sansınız var mı simdiden cooook tesekkur ediyorum hayırlı aksamlar
 
Kodları boş bir modüle ekleyip deneyin.
 
Korhan Ayhan' Alıntı:
Kodları boş bir modüle ekleyip deneyin.
Genişletmek için tıkla ...

hemen deniyorum hocam :redface:

HOCAM YENİ MODUL ACTIM YUKLEDİM BUTONA TIKLADIM İSTEDİGİM SONUCU ALDIM FAKAT ANA SAYFAYA GİDİNCE İŞLEMİ TEKRARLAMAK İSTİYORUM SU HATAYI VERİYOR
*Makro bu calısma kitabında olmayabilir veya tum makrolar devre disi birakilmis olabilir.
*Güvenlik ayarlarina baktim hic sıkıntı yok hepsine izin verilmis bu hatanın kaynagı ne olabilir hocam saygılar
 
Kodu boş bir modüle uyguladıktan sonra dosyanızı MAKRO İÇEREBİLEN ÇALIŞMA KİTABI formatında kayıt edip kapatın.

Sonra tekrar açın ve kodu çalıştırmayı deneyin.
 
korhan ayhan' Alıntı:
kodu boş bir modüle uyguladıktan sonra dosyanızı makro içerebilen çalışma kitabı formatında kayıt edip kapatın.

Sonra tekrar açın ve kodu çalıştırmayı deneyin.
Genişletmek için tıkla ...

hocam calismayan makroları silip tekrar oluşturdum olumlu sonuc allah sizden razı olsun emeginize saglık hocam buyuksunuz:):):)
 
korhan ayhan' Alıntı:
aşağıdaki kodu deneyiniz.

Kod: 
sub özet_rapor()
    dim s2 as worksheet, s3 as worksheet, wf as worksheetfunction
    dim son as long, x as long, satir as long, bul as range
    
    application.screenupdating = false
    
    set s2 = sheets("sayfa2")
    set s3 = sheets("sayfa3")
    set wf = worksheetfunction
    
    s3.range("a2:f" & s3.rows.count).clear
    son = s2.cells(s2.rows.count, 2).end(3).row
    satir = 2
    
    for x = 5 to son
        ıf s2.cells(x, 2) <> "" then
            ıf wf.countıf(s3.range("a:a"), s2.cells(x, 2)) = 0 then
                s3.cells(satir, 1) = s2.cells(x, 2)
                s3.cells(satir, 2) = wf.sumıf(s2.range("b:b"), s2.cells(x, 2), s2.range("d:d"))
                s3.cells(satir, 3) = s2.cells(x, 3)
                s3.cells(satir, 4) = wf.sumıfs(s2.range("d:d"), s2.range("b:b"), s3.cells(satir, 1), s2.range("c:c"), s3.cells(satir, 3))
                s3.cells(satir, 5) = wf.sumıfs(s2.range("e:e"), s2.range("b:b"), s3.cells(satir, 1), s2.range("c:c"), s3.cells(satir, 3))
                s3.cells(satir, 6) = s2.cells(x, 2) & "_" & s2.cells(x, 3)
                satir = satir + 1
            else
                set bul = s3.range("f:f").find(s2.cells(x, 2) & "_" & s2.cells(x, 3), , , xlwhole)
                ıf bul ıs nothing then
                    satir = s3.cells(s3.rows.count, 3).end(3).row + 1
                    s3.cells(satir, 3) = s2.cells(x, 3)
                    s3.cells(satir, 4) = wf.sumıfs(s2.range("d:d"), s2.range("b:b"), s2.cells(x, 2), s2.range("c:c"), s3.cells(satir, 3))
                    s3.cells(satir, 5) = wf.sumıfs(s2.range("e:e"), s2.range("b:b"), s2.cells(x, 2), s2.range("c:c"), s3.cells(satir, 3))
                    s3.cells(satir, 6) = s2.cells(x, 2) & "_" & s2.cells(x, 3)
                    satir = satir + 1
                end ıf
            end ıf
        end ıf
    next
    
    s3.range("f:f").clear
    s3.range("a1:e" & satir - 1).borders.linestyle = 1
    s3.range("a:d").horizontalalignment = xlcenter
    s3.range("e2:e" & satir - 1).style = "currency"
    
    application.screenupdating = true
    
    msgbox "işleminiz tamamlanmıştır.", vbınformation
end sub
Genişletmek için tıkla ...


korhan hocam bunun anlatımlı videosunu cekebilirmisiniz rica etsem nasıl yaptığınızı öğrenmek istiyorum veya bu konu hakkında video linki filan atabilirmisiniz şimdiden teşekkürler
 
Bu konuya hakim baska hocalarim da yardimci olabilirler tesekkurler simdiden.
 
Son düzenleme:
Korhan Ayhan' Alıntı:
Aşağıdaki kodu deneyiniz.

Kod: 
Sub ÖZET_RAPOR()
    Dim S2 As Worksheet, S3 As Worksheet, WF As WorksheetFunction
    Dim Son As Long, X As Long, Satir As Long, Bul As Range
    
    Application.ScreenUpdating = False
    
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Set WF = WorksheetFunction
    
    S3.Range("A2:F" & S3.Rows.Count).Clear
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
    Satir = 2
    
    For X = 5 To Son
        If S2.Cells(X, 2) <> "" Then
            If WF.CountIf(S3.Range("A:A"), S2.Cells(X, 2)) = 0 Then
                S3.Cells(Satir, 1) = S2.Cells(X, 2)
                S3.Cells(Satir, 2) = WF.SumIf(S2.Range("B:B"), S2.Cells(X, 2), S2.Range("D:D"))
                S3.Cells(Satir, 3) = S2.Cells(X, 3)
                S3.Cells(Satir, 4) = WF.SumIfs(S2.Range("D:D"), S2.Range("B:B"), S3.Cells(Satir, 1), S2.Range("C:C"), S3.Cells(Satir, 3))
                S3.Cells(Satir, 5) = WF.SumIfs(S2.Range("E:E"), S2.Range("B:B"), S3.Cells(Satir, 1), S2.Range("C:C"), S3.Cells(Satir, 3))
                S3.Cells(Satir, 6) = S2.Cells(X, 2) & "_" & S2.Cells(X, 3)
                Satir = Satir + 1
            Else
                Set Bul = S3.Range("F:F").Find(S2.Cells(X, 2) & "_" & S2.Cells(X, 3), , , xlWhole)
                If Bul Is Nothing Then
                    Satir = S3.Cells(S3.Rows.Count, 3).End(3).Row + 1
                    S3.Cells(Satir, 3) = S2.Cells(X, 3)
                    S3.Cells(Satir, 4) = WF.SumIfs(S2.Range("D:D"), S2.Range("B:B"), S2.Cells(X, 2), S2.Range("C:C"), S3.Cells(Satir, 3))
                    S3.Cells(Satir, 5) = WF.SumIfs(S2.Range("E:E"), S2.Range("B:B"), S2.Cells(X, 2), S2.Range("C:C"), S3.Cells(Satir, 3))
                    S3.Cells(Satir, 6) = S2.Cells(X, 2) & "_" & S2.Cells(X, 3)
                    Satir = Satir + 1
                End If
            End If
        End If
    Next
    
    S3.Range("F:F").Clear
    S3.Range("A1:E" & Satir - 1).Borders.LineStyle = 1
    S3.Range("A:D").HorizontalAlignment = xlCenter
    S3.Range("E2:E" & Satir - 1).Style = "Currency"
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Hocam supersiniz video cekme sansiniz var mi rica etsem veya resimli anlatabilirmisiniz nasil yaptiginizi video icin tel verebilirim isterseniz whatsapptan da atabilirsiniz hocam simdiden tesekkurler hocam
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst