süzülen bir sutünda, süzülmüş satırların bir satır sonrası

Katılım
1 Ağustos 2011
Mesajlar
4
Excel Vers. ve Dili
türkçe-2007
merhabalar, kolay gelsin. benim sorunum şu: a sütununda 50 satır dolu verim var. a sütununu istediğim kriterlerde süzdüm. şimdi a sütünunda 4 verim kaldı.
bunlarda örnek: 10-20-30-40. satırlar gözüküyor. benim istediğim bundan sonra gelecek satırları bulmak yani : 11-21-31-41. satırları görmek. (tabikii sütunum gerçekte 700-800 satır) ilginize şimdiden teşekkür ederim.......ferudun2011
 

Korhan Ayhan

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

Forumumuza hoşgeldiniz.

Örnek dosya ekleyerek ve sorunuzu dosyanız üzerinde açıklayarak sorarmısınız.
 
Katılım
1 Ağustos 2011
Mesajlar
4
Excel Vers. ve Dili
türkçe-2007
süzülen bir sütunda süzülmüş satırların bir sonraki satırı

kolay gelsin. ek'te bir xls gönderiyorum. belki daha anlaşılır olabilir. selamlar
 

Ekli dosyalar

Korhan Ayhan

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

Belirttiğiniz rakamlara ulaşarak nasıl bir işlem yapmak istiyorsunuz?

Yani amacınız bu değerleri toplamak mı? Ya da başka bir yerde listelemek mi?
 
Katılım
1 Ağustos 2011
Mesajlar
4
Excel Vers. ve Dili
türkçe-2007
Korhan bey çok teşekkür ederim ilginize... Satırda ne varsa olduğu gibi başka bir sayfaya listelemek istiyorum.. Kolay gelsin..
 

Korhan Ayhan

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

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kod;

Kod:
Option Explicit
 
Sub LİSTELE()
    Dim S1 As Worksheet, S2 As Worksheet, Satır As Integer, Hücre As Range
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
 
    S2.Range("A2:B6" & Rows.Count).ClearContents
    Satır = 2
 
    If Not S1.AutoFilter.Filters.Item(1).On Then
        MsgBox "Sayfada aktif filtre olmadığı için işleminiz iptal edilmiştir !", vbCritical
        Exit Sub
    End If
 
    For Each Hücre In S1.Range("A2:A" & S1.Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible)
        S2.Cells(Satır, 1) = Hücre.Offset(1, 0).Row
        S2.Cells(Satır, 2) = Hücre.Offset(1, 0).Value
        Satır = Satır + 1
    Next
 
    S2.Select
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

Üst