Arama ile ilgili macro

[murtiss]

merhaba,
bu konu ile ilgili onlarca dokumana baktim ama istedigimi bulamadim,
ugrastim
yapmak istedigim;
veriler ve arama diye iki tane sayfa var.
veriler sayfasinda kriterlerime uygun 500 satir 8-10 sutun veriler var
arama sayfasinda ise bir textbox a yazdigim verinin bulundugu satiri
yine arama sayfasinda a10 dan itibaren satir satir yazdirmasini istiyorum

yardimci olabilecek arkadaslara simdiden tesekkur ederim


murtiss

 

[Orion1]

Forumda gelişmiş süzgeç diye arama yapınız.

 

[murtiss]

tesekkurler evren hemen bakiyorum

 

[murtiss]

bunu buldum isime yarar aslinda

bunun aciklamasini nedir ?

S1.Columns("A:C").Clear
S2.Columns("A:C").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=S1.Range("F1:G2"), CopyToRange:=S1.Range("A1"), Unique:=False

 

[Orion1]

bunu buldum isime yarar aslinda

bunun aciklamasini nedir ?

S1.Columns("A:C").Clear
S2.Columns("A:C").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=S1.Range("F1:G2"), CopyToRange:=S1.Range("A1"), Unique:=False

* S1 diye tanımlı sayfada A:C kolonları temizleniyor.
S2 diye tanımlanan sayfada Süzme yapılıp (a:c sütunları süzülüyor).S1 diye tanımlanan sayfada F1 G1 de arama kriter başlık ları F2 ve G2 de arama kriterleri Olan Bir süzme yapılıyor ve süzülen veriler S1 diye tanımlı sayfada A1 hücresinden itibaren kopyalanıyor.
Burada dikkat edilmesi gereken nokta kaynak verilerdeki süzülecek olan sütun başlıklarını hedef sayfada F1 ve G1 Hücrelerine yazmak ve Onlara ait kriterlerinide bir alttaki satır yazmaktır.Yani kriterlerde hedef sayfada F2 ve G2 'ye yazılacak.

 

[Orion1]

Ben sizin için yolladığınız dosyayı hazırladım.
Arama sayfasında textboxlara kriterleri giriniz o süzme işlemini yapacaktır.

Sub suz()
Dim satici As String, mlzm As String, snty As String
If TextBox1.Value = "" Then
    satici = "*"
    Else
    satici = TextBox1.Value
End If
If TextBox2.Value = "" Then
    mlzm = "*"
    Else
    mlzm = TextBox2.Value
End If
If TextBox3.Value = "" Then
    snty = "*"
    Else
    snty = TextBox3.Value
End If
Range("T2").Value = satici
Range("U2") = mlzm
Range("V2") = snty
Set s1 = Sheets("Arama")
Set s2 = Sheets("Veriler")
s1.Range("A10:L65536").Clear
s2.Columns("A:L").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=s1.Range("T1:V2"), CopyToRange:=s1.Range("A10"), Unique:=False

End Sub

 

[murtiss]

Evren cok sagol
Allah tuttugunu altin etsin ne diyeyim

birsey daha istesem bu inputbox lar bos oldugu zaman o arama sayfasindaki
a11 den sonrasi bos olmasi icin nasil bir kod yazmam gerekir ?

 

[Orion1]

Evren cok sagol
Allah tuttugunu altin etsin ne diyeyim

birsey daha istesem bu inputbox lar bos oldugu zaman o arama sayfasindaki
a11 den sonrasi bos olmasi icin nasil bir kod yazmam gerekir ?

Asılnda benim yaptığım tam arama mantığına uygundur.Ama siz nasıl istiyorsunuz?
Hepsi boş oluncamı 2si boş oluncamı biri boş oluncamı süzme yapmasın?

 

[murtiss]

istedigim veriler sutununda veriler dursun
arama sutunundaki inputbox lardan herhangi birine veri girdigimde veriler sutununda inputbox1 icin satici inputbox2 icin malzeme inputbox3 icin santiye deki verilere uygun olani getirsin
eger bu inputbox larin hepsi bos oldugunda arama sutunundaki a10 daki no satici alinan malzeme vs satiri dursun
diger alt taraftaki hersey silinsin.
yani arama yaptigimda aramalar gelsin
inputbox daki herseyi sildigimde arama sayfasinda veri bulunmasin

anlatabildimmi bilmiyorum

 

[Orion1]

Doğru anladımmı bilmiyorum.
Dosyayı inceleyiniz.
Hepsini listelemek içn textboxı silip * karakterini giriniz.

 

[murtiss]

Kesinlikle tam istedigim gibi ))))

tesekkurler tesekkurler tesekkurler
tesekkurler teseekkurler tesekkurler
tesekkurler tesekurler tesekkurler
tesekkurller tesekkurler tesekkurler
tesekkurler tesekkurler tesekkurler

 

[Orion1]

Kesinlikle tam istedigim gibi ))))

tesekkurler tesekkurler tesekkurler
tesekkurler teseekkurler tesekkurler
tesekkurler tesekurler tesekkurler
tesekkurller tesekkurler tesekkurler
tesekkurler tesekkurler tesekkurler

Rica ederim.
İyi çalışmalar.

 

[mustafa7691]

hakikaten mükemmel Sn Evren Gizlen Yine döktürmüşsünüz aklınıza sağlık.

 

[Orion1]

hakikaten mükemmel Sn Evren Gizlen Yine döktürmüşsünüz aklınıza sağlık.

Beni takip etmeye devam edin.