excellde listeleme yaparken kasıyor :((

B

blackkugu

Katılım
19 Mayıs 2022
Mesajlar
69
Excel Vers. ve Dili
vba
merhabalar; belirli sutundaki tarihlerde tarama yapıp tarama sonucunu listelerken excell kasıyor. Nasıl bir kodlama yapmam gerekiyor.
sayfa2 de A D F K sutunlarından aşağıya doğru tarihler listeleniyor.
sayfa1 de A sutununda örnek veriyorum 3. aydaki tarihleri çektikten sonra D deki sutunlardaki 3. aydaki tarihleri çekip listesin istiyorum. Kasmadan nasıl çekmem gerekir ki ?
Bende A D F K sutunlarında her biri için For nex kullandım acaba ondan mı ? kasıyor. 4 tane for nex oluyor
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
569
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
blackkugu' Alıntı:
merhabalar; belirli sutundaki tarihlerde tarama yapıp tarama sonucunu listelerken excell kasıyor. Nasıl bir kodlama yapmam gerekiyor.
sayfa2 de A D F K sutunlarından aşağıya doğru tarihler listeleniyor.
sayfa1 de A sutununda örnek veriyorum 3. aydaki tarihleri çektikten sonra D deki sutunlardaki 3. aydaki tarihleri çekip listesin istiyorum. Kasmadan nasıl çekmem gerekir ki ?
Bende A D F K sutunlarında her biri için For nex kullandım acaba ondan mı ? kasıyor. 4 tane for nex oluyor
Genişletmek için tıkla ...
Son satır diye bișey kullaniyormusunuz tüm sütünü mu For next ediyor, ondan olabilir For next hepsi aynı anda mı çalışıyor, çalışması gerekir mi yapınızı bilmediğim için aklıma gelenleri yazdım, örnek dosya yüklerseniz daha çabuk cevap bulabilirsiniz.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Alternatif olarak For-Next döngüsü yerine Find-FindNext kullanılabilir. Ya da en hızlısı dizi yöntemini kullanabilirsiniz.

Örnekler;

VBA kullanarak hücreler içinden belirli değer ile başlayan veriyi arayıp bulduğunda A1 den başlayarak alt alta sıralama

Excelde A100:ABC100 hücreleri boyunca "Barkod No:" ile başlayan veriyi arayıp bulma ve bulduğu her "Barkod No:" ile başlayan hücre değerini A1 den başlayarak alt alta sıralamak istiyorum. mümkünmüdür
www.excel.web.tr www.excel.web.tr

Soru - Makro ile Düşeyara

Herkese Merhaba aşağıdaki kodda düşey ara Sadece B14 teki satırın G14hücresine geliyor. Ama G15 G16 G17 diye kodu nasıl revize edebilirim. Yardımcı olabilecek olan var mi. Sub Duseyara() Dim s1 As Worksheet, s2 As Worksheet, i As Long, c As Range, sat As Long Set s1 =...
www.excel.web.tr www.excel.web.tr

Silinecek Listesindekileri Kaynak Listeden bul sil

Option Explicit Sub BUL_SİL() Dim S1 As Worksheet, S2 As Worksheet, X As Long, SAY As Long, Y As Long Set S1 = Sheets("Kaynak") Set S2 = Sheets("Silinecek Listesi") Application.ScreenUpdating = False For X = 1 To S2.Range("A65536").End(3).Row SAY =...
www.excel.web.tr www.excel.web.tr

Bu örnekleri kendi dosyanıza göre uyarlayabilirsiniz.
 
B

blackkugu

Katılım
19 Mayıs 2022
Mesajlar
69
Excel Vers. ve Dili
vba
Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' farenin tıklamasıyla  çalışıyor
  'MsgBox (Target.Value) ' target.value seçili hücrenin içerisindeki değeri okuyorsun.

 
'If Not Intersect(Target, [B14:AF39]) Is Nothing Then  ' hangi aralığın aktif olacağını belirliyoruz.
'End If

 
  'MsgBox Target.Value
 
  ' arama yapacak kodlar listesi
 
    If Intersect(Target, [B14:AF39]) Is Nothing Or Target.Row < 12 Then Exit Sub ' sadece B sutunundaki alanın çift tıklanması sağlanıyor.
    If ActiveCell <> Empty Then ' hücre doluysa çalışacak kod bloğu
    
    If Worksheets("Takvims").Range("AF8").Value = True Then
    

    
    
    
    
    
    Dim i As Integer
    Dim j As Integer
    Dim Sayac As Integer
    Dim SinananVeri As String
    Veri = Target.Value
    SinananVeri = Veri
    'MsgBox "SinananVeri" + SinananVeri
    Set Say1 = Worksheets("Takvims")
    Set Say2 = Worksheets("Tatiller")
    
    Say1.Range("C41:C80").Font.ColorIndex = False
    Say1.Range("E41:E80").Font.ColorIndex = False
    
    toplam_satir = Say1.Cells(Rows.Count, "B").End(xlUp).Row + 1
    Say1.Range("b41:b" & 41 + toplam_satir).Value = ""
    Say1.Range("c41:c" & 41 + toplam_satir).Value = ""
    Say1.Range("e41:e" & 41 + toplam_satir).Value = ""
    
    
    
    Say1.Range("b41:b" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    Say1.Range("c41:c" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    Say1.Range("e41:e" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Bold = False
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Size = 9
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Underline = False
    
    
    j = 42
    q = 5
    'Say1.Range("A2:A5").Clear
     'Hücreleri önceden temizleyim
    
    Say1.Range("c42:c80").Value = "" ' hücreleri önceden temizleyim
    Say1.Range("e42:e100").Value = "" ' hücreleri önceden temizleyim
    'Say1.Range("B42:B80").NumberFormat = "dd.mm.yyyy" ' temizlenen hücre biçimini tarih formatına çeviriyorum.
    
    Range("B41").Interior.ColorIndex = 41
    Range("C41").Value = "RESMİ TATİLLER"
    
    Range("C41").Font.Bold = True
    Range("C41").Font.Size = 10
    Range("C41").Font.Underline = xlUnderlineStyleSingle
    
    
    
    For i = 1 To 25
        'MsgBox Say2.Cells(i, 2) ' Say2.Cells(i, 2) i yukarıdan aşağıya doğru okuma 2 ise sutun sıra adları A=1 se B=2 C=3
        'If WorksheetFunction.CountIf(Say2.Cells(i, 2), SinananVeri) > 0 Then
        'Say1.Range("A2:A5").Clear
        If Format(SinananVeri, "mm") = Format(Say2.Cells(i, 2), "mm") Then ' sayfa 2 deki 2 yani B sutunu tarıyoruz
            'MsgBox Say2.Cells(i, 2)
            'Say1.Cells("A1", "A20") = ""
            Say1.Cells(j, 3) = "'" & Say2.Cells(i, 2) ' sayfa 2 deki B sutunundaki veriyi alıp sayfa 1 deki 1 yani A sutununa yukarıdan aşağıya doğru listeliyoruz
            Say1.Cells(j, 5) = Say2.Cells(i, 3)
            Sayac = Sayac + 1
            j = j + 1
        End If
        
    Next i
    
    son_dolu_hucre = Say1.Cells(Rows.Count, "c").End(xlUp).Row + 1
    'MsgBox Say2.Name & "'de aramış olduğunuz " & Veri & " verisini içeren toplam " & Sayac & " adet hücre değeri bulundu ve " & Say1.Name & "'de listelendi."
    'MsgBox toplam_satir
    
    'son_dolu_hucre = Range("c" & Rows.Count).End(xlUp).Row
    'MsgBox "son dolu hücre " & son_dolu_hucre
    Range("B" & son_dolu_hucre).Interior.ColorIndex = 3
    Range("C" & son_dolu_hucre).Value = "DİNİ BAYRAMLAR"
    Range("C" & son_dolu_hucre).Font.Bold = True
    Range("C" & son_dolu_hucre).Font.Size = 10
    Range("C" & son_dolu_hucre).Font.Underline = xlUnderlineStyleSingle
    Sayac = 1
    For i = 1 To 25
        If Format(SinananVeri, "mm") = Format(Say2.Cells(i, 17), "mm") Then ' sayfa 2 deki 2 yani B sutunu tarıyoruz
        'MsgBox Say2.Cells(i, 2)
        'Say1.Cells("A1", "A20") = ""
            Say1.Cells(son_dolu_hucre + 1, 3) = "'" & Say2.Cells(i, 17) ' sayfa 2 deki B sutunundaki veriyi alıp sayfa 1 deki 1 yani A sutununa yukarıdan aşağıya doğru listeliyoruz
            Say1.Cells(son_dolu_hucre + 1, 5) = Say2.Cells(i, 18)
            Sayac = Sayac + 1
            son_dolu_hucre = son_dolu_hucre + 1
        End If
    Next i
    


    son_dolu_hucre = Say1.Cells(Rows.Count, "c").End(xlUp).Row + 1

    Range("B" & son_dolu_hucre).Interior.ColorIndex = 39
    Range("C" & son_dolu_hucre).Value = "ÖZEL GÜNLER"
    Range("C" & son_dolu_hucre).Font.Bold = True
    Range("C" & son_dolu_hucre).Font.Size = 10
    Range("C" & son_dolu_hucre).Font.Underline = xlUnderlineStyleSingle
    Sayac = 1
    For i = 1 To 25
        If Format(SinananVeri, "mm") = Format(Say2.Cells(i, 5), "mm") Then ' sayfa 2 deki 2 yani B sutunu tarıyoruz
        'MsgBox Say2.Cells(i, 2)
        'Say1.Cells("A1", "A20") = ""
            Say1.Cells(son_dolu_hucre + 1, 3) = "'" & Say2.Cells(i, 5) ' sayfa 2 deki B sutunundaki veriyi alıp sayfa 1 deki 1 yani A sutununa yukarıdan aşağıya doğru listeliyoruz
            Say1.Cells(son_dolu_hucre + 1, 5) = Say2.Cells(i, 6)
            Sayac = Sayac + 1
            son_dolu_hucre = son_dolu_hucre + 1
        End If
    Next i


    son_dolu_hucre = Say1.Cells(Rows.Count, "c").End(xlUp).Row + 1

    Range("B" & son_dolu_hucre).Interior.ColorIndex = 50
    Range("C" & son_dolu_hucre).Value = "VERGİ (EV,ARABA) ÖDEME GÜNLERİ"
    Range("C" & son_dolu_hucre).Font.Bold = True
    Range("C" & son_dolu_hucre).Font.Size = 10
    Range("C" & son_dolu_hucre).Font.Underline = xlUnderlineStyleSingle
    Sayac = 1
    For i = 1 To 25
        If Format(SinananVeri, "mm") = Format(Say2.Cells(i, 8), "mm") Then ' sayfa 2 deki 2 yani B sutunu tarıyoruz
        'MsgBox Say2.Cells(i, 2)
        'Say1.Cells("A1", "A20") = ""
            Say1.Cells(son_dolu_hucre + 1, 3) = "'" & Say2.Cells(i, 8) ' sayfa 2 deki B sutunundaki veriyi alıp sayfa 1 deki 1 yani A sutununa yukarıdan aşağıya doğru listeliyoruz
            Say1.Cells(son_dolu_hucre + 1, 5) = Say2.Cells(i, 9)
            Sayac = Sayac + 1
            son_dolu_hucre = son_dolu_hucre + 1
        End If
    Next i

    son_dolu_hucre = Say1.Cells(Rows.Count, "c").End(xlUp).Row + 1
    aktif_gun = son_dolu_hucre
    Range("B" & son_dolu_hucre).Interior.ColorIndex = 49
    Range("C" & son_dolu_hucre).Value = "KİRACILAR GİRİŞ TARİHLERİ"
    Range("C" & son_dolu_hucre).Font.Bold = True
    Range("C" & son_dolu_hucre).Font.Size = 10
    Range("C" & son_dolu_hucre).Font.Underline = xlUnderlineStyleSingle
    Sayac = 1
    For i = 1 To 25
        If Format(SinananVeri, "yyyy") = Format(Say2.Cells(i, 11), "yyyy") Then ' sayfa 2 deki 2 yani B sutunu tarıyoruz
        'MsgBox Say2.Cells(i, 2)
        'Say1.Cells("A1", "A20") = ""
            Say1.Cells(son_dolu_hucre + 1, 3) = "'" & Format(Say2.Cells(i, 11), "dd") & "." & Format(SinananVeri, "mm") & "." & Format(Say2.Cells(i, 11), "yyyy") ' sayfa 2 deki B sutunundaki veriyi alıp sayfa 1 deki 1 yani A sutununa yukarıdan aşağıya doğru listeliyoruz
            Say1.Cells(son_dolu_hucre + 1, 5) = Say2.Cells(i, 12)
            Sayac = Sayac + 1
            son_dolu_hucre = son_dolu_hucre + 1
            

            
        End If
    Next i
    
    son_dolu_hucre_kiracı = Say1.Cells(Rows.Count, "c").End(xlUp).Row + 1
    'MsgBox aktif_gun & "+" & son_dolu_hucre_kiracı
    For i = aktif_gun + 1 To son_dolu_hucre_kiracı - 1
    
    'MsgBox Format(Date, "dd.mm.yyyy") & " + " & Format(Say1.Cells(i, 3), "dd.mm.yyyy")
        If Format(Date, "dd.mm.yyyy") = Format(Say1.Cells(i, 3), "dd.mm.yyyy") Then ' sayfa 2 deki 2 yani B sutunu tarıyoruz
        'MsgBox Say2.Cells(i, 2)
        'Say1.Cells("A1", "A20") = ""
            Say1.Cells(i, 3).Font.ColorIndex = 26
            Say1.Cells(i, 5).Font.ColorIndex = 26
            'Say1.Cells(son_dolu_hucre + 1, 5) = Say2.Cells(i, 12)
            'Sayac = Sayac + 1
            'son_dolu_hucre = son_dolu_hucre + 1
            

            
        End If
    Next i
    

    'Range("c" & aktif_gun + 1 & ":C" & son_dolu_hucre_kiracı - 1).Sort key1:=Range("A" & aktif_gun + 1), ORDER1:=xlDescending
    
    Else
    
    'MsgBox "aylık pasif durum"
    

    
    End If
    
 
  End If

End Sub
içerik özel fakat bu şekilde kodlama yapmıştım.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kod hücre seçimine göre tasarlanmıştır. Bu durumda her hücre seçiminde devreye gireceği için performans kaybı olması kaçınılmazdır. Bunun yerine bir buton kullanabilirsiniz. Ya da sayfanın aktif olma durumuna yazabilirsiniz. Böyle sürekli çalışmak yerine sizin kontrolünüzde çalışarak daha iyi performans verecektir.
 
B

blackkugu

Katılım
19 Mayıs 2022
Mesajlar
69
Excel Vers. ve Dili
vba
Korhan Ayhan' Alıntı:
Kod hücre seçimine göre tasarlanmıştır. Bu durumda her hücre seçiminde devreye gireceği için performans kaybı olması kaçınılmazdır. Bunun yerine bir buton kullanabilirsiniz. Ya da sayfanın aktif olma durumuna yazabilirsiniz. Böyle sürekli çalışmak yerine sizin kontrolünüzde çalışarak daha iyi performans verecektir.
Genişletmek için tıkla ...
aslında sürekli hücrelere tıklamıyorum ilgili tarihin hücresine bir kere tıkladığımda verileri yavaş yavaş listeliyor. İstediğim hemen listelemesi, dediğiniz gibi hücrelerde sürekli bir tıklama söz konusu değil.
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Kullandığınız kod yapısı kısa ya da işlem yükü içermeyen dosyalarda kullanılabilir. Eğer kasıyorsa dediğim gibi kodların işlem süresinin uzunluğandandır.
Dosyanızdaki içeriklerin özel olan verileri rastgele veri olarak değitirerek dosyanızı paylaşırsanız bakabiliriz.
Kodlarınza bakarak bir şeyler yapayım dedim ama çok zorladı.
 
dEdE

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
blackkugu' Alıntı:
aslında sürekli hücrelere tıklamıyorum
Genişletmek için tıkla ...
Merhaba,
Sürekli hücrelere tıklamıyorsunuz ama kodlarınız sürekli hücrelere başvuruyor. Bu önemli bir yavaşlama nedenidir. Bunu önlemek için;
If Worksheets("Takvims").Range("AF8").Value = True Then satırından sonra Application.ScreenUpdating = False satırını eklemelisiniz. Kodun son satırından (End Sub) önce deApplication.ScreenUpdating = Trueeklenmelidir.
Ayrıca kodların sadeleştirilmesi(optimize edilmesi)de hızı artırır.
Örneğin;
Sizin kodunuzdaki
C++: 
    Say1.Range("C41:C80").Font.ColorIndex = False
    Say1.Range("E41:E80").Font.ColorIndex = False
YerineSay1.Range("C41:C80,E41:E80").Font.ColorIndex = False
Yine
C++: 
Say1.Range("b41:b" & 41 + toplam_satir).Value = ""
    Say1.Range("c41:c" & 41 + toplam_satir).Value = ""
    Say1.Range("e41:e" & 41 + toplam_satir).Value = ""
YerineSay1.Range("b41:c" & 41 + toplam_satir & ",e41:e" & 41 + toplam_satir).Value = ""
Ve
C++: 
 Say1.Range("b41:b" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    Say1.Range("c41:c" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    Say1.Range("e41:e" & 41 + toplam_satir).Interior.ColorIndex = xlNone
YerineSay1.Range("b41:c" & 41 + toplam_satir & ",e41:e" & 41 + toplam_satir).Interior.ColorIndex = xlNone
Ve de
C++: 
Say1.Range("c41:c" & 41 + toplam_satir).Font.Bold = False
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Size = 9
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Underline = False
Yerine
C++: 
With Say1.Range("c41:c" & 41 + toplam_satir)
        .Font.Bold = False
        .Font.Size = 9
        .Font.Underline = False
    End With
Şeklinde düzelemeler yapılabilir.
Ayrıca çalışma sayfasındaki değişikliklerden tetiklenen olaylar varsa Application.EnableEvents = False satırı ile devre dışı bırakılmalı ve procedure'un son satırından hemen önce Application.EnableEvents = True satırı ile tekrar aktif edilmelidir.
Bu düzenlemelerin hızı önemli ölçüde artıracağını söyleyebilirim.
 
Son düzenleme:
B

blackkugu

Katılım
19 Mayıs 2022
Mesajlar
69
Excel Vers. ve Dili
vba
dEdE' Alıntı:
Merhaba,
Sürekli hücrelere tıklamıyorsunuz ama kodlarınız sürekli hücrelere başvuruyor. Bu önemli bir yavaşlama nedenidir. Bunu önlemek için;
If Worksheets("Takvims").Range("AF8").Value = True Then satırından sonra Application.ScreenUpdating = False satırını eklemelisiniz. Kodun son satırından (End Sub) önce deApplication.ScreenUpdating = Trueeklenmelidir.
Ayrıca kodların sadeleştirilmesi(optimize edilmesi)de hızı artırır.
Örneğin;
Sizin kodunuzdaki
C++: 
    Say1.Range("C41:C80").Font.ColorIndex = False
    Say1.Range("E41:E80").Font.ColorIndex = False
YerineSay1.Range("C41:C80,E41:E80").Font.ColorIndex = False
Yine
C++: 
Say1.Range("b41:b" & 41 + toplam_satir).Value = ""
    Say1.Range("c41:c" & 41 + toplam_satir).Value = ""
    Say1.Range("e41:e" & 41 + toplam_satir).Value = ""
YerineSay1.Range("b41:c" & 41 + toplam_satir & ",e41:e" & 41 + toplam_satir).Value = ""
Ve
C++: 
 Say1.Range("b41:b" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    Say1.Range("c41:c" & 41 + toplam_satir).Interior.ColorIndex = xlNone
    Say1.Range("e41:e" & 41 + toplam_satir).Interior.ColorIndex = xlNone
YerineSay1.Range("b41:c" & 41 + toplam_satir & ",e41:e" & 41 + toplam_satir).Interior.ColorIndex = xlNone
Ve de
C++: 
Say1.Range("c41:c" & 41 + toplam_satir).Font.Bold = False
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Size = 9
    Say1.Range("c41:c" & 41 + toplam_satir).Font.Underline = False
Yerine
C++: 
With Say1.Range("c41:c" & 41 + toplam_satir)
        .Font.Bold = False
        .Font.Size = 9
        .Font.Underline = False
    End With
Şeklinde düzelemeler yapılabilir.
Ayrıca çalışma sayfasındaki değişikliklerden tetiklenen olaylar varsa Application.EnableEvents = False satırı ile devre dışı bırakılmalı ve procedure'un son satırından hemen önce Application.EnableEvents = True satırı ile tekrar aktif edilmelidir.
Bu düzenlemelerin hızı önemli ölçüde artıracağını söyleyebilirim.
Genişletmek için tıkla ...

elinize sağlık hocam inanın "If Worksheets("Takvims").Range("AF8").Value = True Then satırından sonra Application.ScreenUpdating = False satırını eklemelisiniz. Kodun son satırından (End Sub) önce deApplication.ScreenUpdating = Trueeklenmelidir. " buradaki olay çok hızlanmasına sebep oldu veriler satır satır tek tek geliyordu şimdi direk geliyor. sağol varol
 
dEdE

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
blackkugu' Alıntı:
... Application.ScreenUpdating = False satırını eklemelisiniz. Kodun son satırından (End Sub) önce deApplication.ScreenUpdating = True eklenmelidir. " buradaki olay çok hızlanmasına sebep oldu veriler satır satır tek tek geliyordu şimdi direk geliyor. ...
Genişletmek için tıkla ...
Önerdiğim diğer düzenlemeleri de değerlendirmelisiniz. Daha da hızlandığını göreceksiniz.
Hoşça kalın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst