• DİKKAT

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

Gelişmiş filtre yardımı

korhan hocam bi yardim edeydiniz ya :) bi youtube videosu resimli veya makale ne olursa teşşekürler
 
arkadaslar korhan hocam olmayabilir burda siz yardimci olun bari

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


su kodu bana bolumlere ayırın veya hangi kisim hangi gorevi goruyor biri bana aciklasin lutfen video resim ne sekilde olursa ki ben kodu kendime gore uyarlaya bileyim emeginiz icin tesekkurler
 
Kodun hangi bölümünü öğrenmek istiyorsunuz?
 
Merhaba hocam

korhan ayhan' Alıntı:
kodun hangi bölümünü öğrenmek istiyorsunuz?
Genişletmek için tıkla ...

hocam cok guzel bir calısma yapmıssınız super otesi ama ben bunu makroda yazamıorum siz bir video filan hazırlayabilirmisiniz rica etsem hem bana hem benden sonrakilere cok buyuk katkı saglar

yani sayfa 2 de ki veriler sayfa3 te raporlanıyor cok ıyı bır sekılde bunla ılgılı bır calısma veya aynı ornek uzerinden bir calisma da olur hocam buyuksunuz
 
Merhaba,

Kodlama öğrenmek istiyorsanız forumun dershane bölümünü ve uygulamalı anlatımlar bölümünü incelemenizi öneririm.

Ben hazırladığım prosedürün içine küçük notlar ekledim. Belki kendinize uyarlarken faydası olabilir.

Kod: 
'Prosedürün adı
Sub ÖZET_RAPOR()
    'Prosedür içinde kullanılan değişkenleri tanımlıyoruz.
    
    Dim S2 As Worksheet, S3 As Worksheet, WF As WorksheetFunction
    Dim Son As Long, X As Long, Satir As Long, Bul As Range
    
    'Ekran hareketlerini pasif yapıyoruz. Bu kodun hızlı çalışmasına katkıda bulunuyor.
    Application.ScreenUpdating = False
    
    'İşlemde kullanılacak sayfaları ve fonksiyon özelliğini sabitliyoruz.
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Set WF = WorksheetFunction
    
    'Sayfa3 isimli sayfadaki daha önce aktarılmış verileri siliyoruz.
    S3.Range("A2:F" & S3.Rows.Count).Clear
    
    'Sayfa2 isimli sayfadaki B sütunundaki son satırı tespit ediyoruz.
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
    
    'Verilerin hangi satırdan itibaren yazılacağını belirliyoruz.
    Satir = 2
    
    'Sorgulama için verileri döngüye alıyoruz.
    For X = 5 To Son
        'Eğer Sayfa2 isimli sayfada ilgili satırdaki B sütunundaki hücre boş değilse
        If S2.Cells(X, 2) <> "" Then
            'Sayfa3 isimli sayfanın A sütununda bu hücreye ait veriyi say, sonuç sıfırsa verileri Sayfa3 isimli sayfaya aktarıyoruz.
            'Burada sonucun sıfır olması demek verinin ilk kayıt olduğu anlamına gelmektedir.
            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))
                'Kodun can alıcıbölümü burasıdır. F sütununa benzersiz bir alan oluşturuyoruz. CİNS ve TÜR parametlerini birleştirip F sütununa yazdırıyoruz.
                S3.Cells(Satir, 6) = S2.Cells(X, 2) & "_" & S2.Cells(X, 3)
                Satir = Satir + 1
            'Sonuç sıfırdan büyükse
            Else
                'Sayfa3 isimli sayfada F sütununda (can alıcı bölüm) CİNS ve TÜR birleşimini arıyoruz.
                Set Bul = S3.Range("F:F").Find(S2.Cells(X, 2) & "_" & S2.Cells(X, 3), , , xlWhole)
                'Aranılan kayıt sayfada yoksa
                If Bul Is Nothing Then
                    'Sayfa3 isimi sayfada C sütunundaki son boş satırın numarasını buluyoruz.
                    Satir = S3.Cells(S3.Rows.Count, 3).End(3).Row + 1
                    'CİNSE ait yeni veriyi ilgili hücrelere aktarıyoruz.
                    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)
                    'Yeni kayıt için satır değişkenini 1 arttırıyoruz. Bu kod satırı yeni verilerin aktarımında üst üste yazılmaması için kullanılmaktadır.
                    Satir = Satir + 1
                End If
            End If
        End If
        'Eğer sorugularını sonlandırıp Sayfa2 isimli sayfadaki tüm kayıtlar bitene kadar döngüye devam ediyoruz.
    Next
    
    'Sayfa3 isimli sayfadaki (can alıcı bölüm) yardımcı sütunu siliyoruz.
    S3.Range("F:F").Clear
    
    'Sayfa3 isimli sayfada oluşan verilere kenarlık ekliyoruz.
    S3.Range("A1:E" & Satir - 1).Borders.LineStyle = 1
    
    'Sayfa3 isimli sayfada A-D sütunlarını ortalayoruz.
    S3.Range("A:D").HorizontalAlignment = xlCenter
    
    'Sayfa3 isimli sayfada E sütununu parasal biçimlendiriyoruz.
    S3.Range("E2:E" & Satir - 1).Style = "Currency"
    
    'Ekran hareketlerini aktif yapıyoruz.
    Application.ScreenUpdating = True
    
    'İşlemin bittiğine ilişkin kullanıcıya uyarı mesajı veriyoruz.
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation

'Prosedürü sonlandırıyoruz.
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Kodlama öğrenmek istiyorsanız forumun dershane bölümünü ve uygulamalı anlatımlar bölümünü incelemenizi öneririm.

Ben hazırladığım prosedürün içine küçük notlar ekledim. Belki kendinize uyarlarken faydası olabilir.

Kod: 
'Prosedürün adı
Sub ÖZET_RAPOR()
    'Prosedür içinde kullanılan değişkenleri tanımlıyoruz.
    
    Dim S2 As Worksheet, S3 As Worksheet, WF As WorksheetFunction
    Dim Son As Long, X As Long, Satir As Long, Bul As Range
    
    'Ekran hareketlerini pasif yapıyoruz. Bu kodun hızlı çalışmasına katkıda bulunuyor.
    Application.ScreenUpdating = False
    
    'İşlemde kullanılacak sayfaları ve fonksiyon özelliğini sabitliyoruz.
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Set WF = WorksheetFunction
    
    'Sayfa3 isimli sayfadaki daha önce aktarılmış verileri siliyoruz.
    S3.Range("A2:F" & S3.Rows.Count).Clear
    
    'Sayfa2 isimli sayfadaki B sütunundaki son satırı tespit ediyoruz.
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
    
    'Verilerin hangi satırdan itibaren yazılacağını belirliyoruz.
    Satir = 2
    
    'Sorgulama için verileri döngüye alıyoruz.
    For X = 5 To Son
        'Eğer Sayfa2 isimli sayfada ilgili satırdaki B sütunundaki hücre boş değilse
        If S2.Cells(X, 2) <> "" Then
            'Sayfa3 isimli sayfanın A sütununda bu hücreye ait veriyi say, sonuç sıfırsa verileri Sayfa3 isimli sayfaya aktarıyoruz.
            'Burada sonucun sıfır olması demek verinin ilk kayıt olduğu anlamına gelmektedir.
            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))
                'Kodun can alıcıbölümü burasıdır. F sütununa benzersiz bir alan oluşturuyoruz. CİNS ve TÜR parametlerini birleştirip F sütununa yazdırıyoruz.
                S3.Cells(Satir, 6) = S2.Cells(X, 2) & "_" & S2.Cells(X, 3)
                Satir = Satir + 1
            'Sonuç sıfırdan büyükse
            Else
                'Sayfa3 isimli sayfada F sütununda (can alıcı bölüm) CİNS ve TÜR birleşimini arıyoruz.
                Set Bul = S3.Range("F:F").Find(S2.Cells(X, 2) & "_" & S2.Cells(X, 3), , , xlWhole)
                'Aranılan kayıt sayfada yoksa
                If Bul Is Nothing Then
                    'Sayfa3 isimi sayfada C sütunundaki son boş satırın numarasını buluyoruz.
                    Satir = S3.Cells(S3.Rows.Count, 3).End(3).Row + 1
                    'CİNSE ait yeni veriyi ilgili hücrelere aktarıyoruz.
                    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)
                    'Yeni kayıt için satır değişkenini 1 arttırıyoruz. Bu kod satırı yeni verilerin aktarımında üst üste yazılmaması için kullanılmaktadır.
                    Satir = Satir + 1
                End If
            End If
        End If
        'Eğer sorugularını sonlandırıp Sayfa2 isimli sayfadaki tüm kayıtlar bitene kadar döngüye devam ediyoruz.
    Next
    
    'Sayfa3 isimli sayfadaki (can alıcı bölüm) yardımcı sütunu siliyoruz.
    S3.Range("F:F").Clear
    
    'Sayfa3 isimli sayfada oluşan verilere kenarlık ekliyoruz.
    S3.Range("A1:E" & Satir - 1).Borders.LineStyle = 1
    
    'Sayfa3 isimli sayfada A-D sütunlarını ortalayoruz.
    S3.Range("A:D").HorizontalAlignment = xlCenter
    
    'Sayfa3 isimli sayfada E sütununu parasal biçimlendiriyoruz.
    S3.Range("E2:E" & Satir - 1).Style = "Currency"
    
    'Ekran hareketlerini aktif yapıyoruz.
    Application.ScreenUpdating = True
    
    'İşlemin bittiğine ilişkin kullanıcıya uyarı mesajı veriyoruz.
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation

'Prosedürü sonlandırıyoruz.
End Sub
Genişletmek için tıkla ...



hocam hakkinizi helal edin gercekten çok tesekkur ediyorum emeginize yureginize saglik superotesisiniz:bravo::bravo::bravo::bravo::bravo::bravo:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst