Açılacak yeni sayfaya, süzgeçlenmiş satırları kopyalatmak

Katılım
2 Ekim 2007
Mesajlar
46
Excel Vers. ve Dili
Türkçe Office 2003
selamlar,

Örnekteki kitabın 200 adlı sayfasında bulunan B sütunu filtrelenecek verileri içeriyor.

Bunlardan belli kodları beraber değerlendirip yeni bir sayfaya kopyalatmak istiyorum. Örnekte 2 farklı sayfada (LIST1-LIST2), toplam 4 ortak kod süzgeçlemesi belirttim. Bunun gibi ortak kodları belirtip, veri sayfasından örnekteki gibi ayrı sayfalara tablolatabileceğim en uygun yöntem nedir?


Veri sayfası aslında 30-40.000 satırdan oluşuyor ve taranacak kod kombinasyonları yaklaşık 30-35 civarında. Yani kimi kombinasyonlarda satır sayısı 1000-2000 olabilir. bu durumda en sağlıklı ve en hızlı çözüm için uygulanması gereken ne olur?

teşekkürler


teşekkürler
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,256
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
Eğer gerçek dosyanızda 40.000 satır formül yoksa AutoFilter çok hızlı metotdur.
Buna alternatif SQL (ADO) ile filitrelenebilir.
 

Korhan Ayhan

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

Ekteki örnek dosyayı incelermisiniz.
 
Katılım
2 Ekim 2007
Mesajlar
46
Excel Vers. ve Dili
Türkçe Office 2003
Çok teşekkürler Korhan hocam yalnız şöyle bir revize yapmak mümkün mü?

Aranacak kod tüm satırda yoklanıyor. Kodu sadece başlangıç kısmı ile aratmak istediğimde (ÖR: 1811****** şeklinde) herhangi bir sütununda 1811'i barındıran her satırı getiriyor. Aramayı tüm satırda değilde sadece B sütununda yaptırmak mümkünmü ?

Sub LİSTELE()
Set S1 = Sheets("200")
Set S2 = Sheets("LİSTE")
S2.Select
[A2:I65536].ClearContents
Satır = 2
For X = 2 To [L65536].End(3).Row
Set Bul = S1.Cells.Find(Cells(X, "L"), LookAt:=xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Cells(Satır, 1) = S1.Cells(Bul.Row, 1)
Cells(Satır, 2) = S1.Cells(Bul.Row, 2)
Cells(Satır, 3) = S1.Cells(Bul.Row, 3)
Cells(Satır, 4) = S1.Cells(Bul.Row, 4)
Cells(Satır, 5) = S1.Cells(Bul.Row, 5)
Cells(Satır, 6) = S1.Cells(Bul.Row, 6)
Cells(Satır, 7) = S1.Cells(Bul.Row, 7)
Cells(Satır, 8) = S1.Cells(Bul.Row, 8)
Cells(Satır, 9) = S1.Cells(Bul.Row, 9)
Satır = Satır + 1
Set Bul = S1.Cells.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
Next
MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub
 
Son düzenleme:
Üst