Şarta uygun verileri çekme

[modoste]

merhaba sayın hocalarım
40000. satıra kadar veri olan bir listem var

isteğim şu
A1:L40000 tablosunda A1:A40000 arasında N1 hücresine yazdığım ifadeyi bulup
O1 den itibaren tabloyu yeniden oluşturmak

ilk tablo aralığı A1:L40000 oluşturulacak tablo ise O1:Z... kaçıncı satıra denk gelirse

 

[Ömer]

Merhaba,

Sorularınızı örnek dosya ile desteklemenizi rica ederim.

 

[modoste]

sayın hocam dosyam şekiller vs lerle 36 mb lık 36000. satırlarda veri var
kısaltıp gönderemedim istediğimi formülle yapabiliyorum sizlerden öğrendiklerimle ama yavaşlatır diye makro ile yapılmasını istedim

 

[Ömer]

Sorularınızda orijinal dosyanızı eklemenize gerek yok. 10-15 satırlık bir dosya ile sorunuzu desteklerseniz hem dosya yapınızı öğreniriz hem de bu şekilde bizimde çalışırken deneme yapma fırsatımız olur. Bu şekilde daha hızlı ve net yanıtlara ulaşabiliriz.

 

[modoste]

anladım ömer hocam bugün en kısa zamanda dosya ekliyorum

 

[Korhan Ayhan]

Merhaba,

40.000 satırlık tablo için makro kullanmak daha etkin olur. Makro dışında özet tablo kullanmanızı önerebilirim.

Aşağıdaki kodu deneyip sonucu gözlemleyin.

Sub AKTAR()
    Dim Kriter As String, Bul As Range, Adres As String, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Kriter = Range("N2").Text
    Satir = 3
    Range("O3:Y" & Rows.Count).ClearContents
    
    Set Bul = Range("A:A").Find(Kriter, , xlValues, xlWhole)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
        Do
            Bul.Resize(1, 11).Copy Cells(Satir, "O")
            Satir = Satir + 1
            Set Bul = Range("A:A").FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    Set Bul = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[modoste]

sayın korhan hocam makroyu uyguladım çözüm net oldu

N2 ye sadece 1 değişken koyup listeden ona göre veri çekildi peki şöyle birşey yapsak
Liste N2:N100 arasında veri
örnek
N2=1900
N3=1901
N4=2205
N4=2207
N5=Boş
N6=3500
gibi veriler yada boş olan değerler olsa
makro yine yukardan aşağıya veri önceliğine göre listelese boş hücreyi atlasa dolu gördüğü hücreleri altalta sıralaa

 

[Korhan Ayhan]

Merhaba,

"N" sütunundaki verileri döngüye alarak sorunu çözebiliriz.

Sub AKTAR()
    Dim X As Integer, Bul As Range, Adres As String, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Satir = 3
    Range("O3:Y" & Rows.Count).ClearContents
    
    For X = 2 To Cells(Rows.Count, "N").End(3).Row
        If Cells(X, "N") <> "" Then
            Set Bul = Range("A:A").Find(Cells(X, "N").Text, , xlValues, xlWhole)
            If Not Bul Is Nothing Then
            Adres = Bul.Address
                Do
                    Bul.Resize(1, 11).Copy Cells(Satir, "O")
                    Satir = Satir + 1
                    Set Bul = Range("A:A").FindNext(Bul)
                Loop While Not Bul Is Nothing And Bul.Address <> Adres
            End If
        End If
    Next
    
    Set Bul = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[modoste]

korhan hocam makroyu son yazdığınızı bu sabah denedim
N sütununda N2 den başlamak kaydıyla altalta verileri çözüyo
veriler arasında boşluk varsa dahi sadece veri olan değerleri listelesin olarak istemiştim
örneğin N2 de veri var N3 boş N4 de veri var
bu şekilde boşluk olan tüm listeyide buluyo
N2 den başlayan verilerde boşluk olmayanları yukarıdan aşağıya doğru veri sırasına göre listeden verileri çekse

 

[Korhan Ayhan]

Merhaba,

#8 nolu mesajımdaki kodu revize ettim. Tekrar deneyiniz.

 

[modoste]

teşekkür ederim hocam doğru verileri çektim listeden.