• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücreye Girlilen Tarihde Doğum Günü Olanları Filtreleme

  • Konbuyu başlatan Konbuyu başlatan askm
  • Başlangıç tarihi Başlangıç tarihi

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,746
Excel Vers. ve Dili
2010-2016
Kolay gelsin. Hayırlı geceler.
Aşağıdaki filtreleme kodları ile yapmaya çalıştım olmadı tarih olduğu için. Doğum günü olanları filtrelemek istiyorum. Yani textbox1 e yazılan 17.11 rakamını dikkate alacak ve o tarihte doğanları listeleyecek. Buna benzer bir kodu mevcut. Ama onda uyarı mesajı veriyor ve sadece bugün doğum günü olanlar için işlem yapıyor. O kodlarda aşağıda bunları textbox1 e 17.11 yazdığım zaman 17.11 de doğanları listeyeleyecek şekilde nasıl yapabilirim.Teşekkürler.
Filtreleme kodları:
Private Sub TextBox1_Change()
Dim METİN1 As String, FC2 As Range
On Error Resume Next
METİN1 = TextBox1.Value
Set FC2 = Range("B2:b65000").Find(What:=METİN1)
Application.Goto Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=2, Criteria1:="*" & TextBox1.Value & "*"
If METİN1 = "" Then
Selection.AutoFilter Field:=2
End If
End Sub


Doğum Günü Mesaj Kodları
Sub denetle()
tarih = Format(Now, "dd.mm")
For i = 1 To Sheets("Sayfa1").Range("a65536").End(3).Row
If tarih = Format(Cells(i, 1), "dd.mm") Then
say = say + 1
mesaj = "Doğum günü olanlar : " & vbCr
msj = msj & Cells(i, 2) & vbCr
End If
Next i
If say >= 1 Then
MsgBox "Bugün doğum günü olan " & say & " kişi var" & vbCr & mesaj & vbCr & msj
End If
End Sub
 
"Metin kutusu tarih formatı" şeklinde arama yaparsanız örneklerin olduğunu hatırlıyorum.

Criteria1 'in karşısına "Format"lanmış halini yazarak deneyin.
 
Textboxa 17.11 yazılıp CommandButton'a basınca A sütununda arar ve D sütununa yazar.
Kod:
Private Sub CommandButton1_Click()
Tarih = TextBox1.Value
For i = 1 To Sheets("Sayfa1").Range("a65536").End(3).Row
son = Sheets("Sayfa1").Range("d65536").End(3).Row + 1
If Tarih Like Format(Sheets("Sayfa1").Cells(i, "a"), "dd.mm") Then
Sheets("Sayfa1").Cells(son, "d") = Sheets("Sayfa1").Cells(i, "a")
End If
Next i
End Sub
 
Son düzenleme:
İlginiz için teşekkürler. Criteria karşısına formatlanmış olarak önce denedim ama olmadı. İstediğim farklı sütununda olması değil. Filtreleme işlemi.
 
Sizin probleminizin çözümü olur mu bilemem ama fikir vermesi açısından ekteki dosyayı inceleyebilirsiniz.
 

Ekli dosyalar

Çok teşekkür ederim. Elinize emeğinize sağlık.
 
Sayın mucit77. kodları aşağıdaki şekilde deniyorum. Yalnız Criteria1:=RGB(255, 0, 0), burdaki RBG nedir bilemedim. (işlem yaptığım sütun t sütunu. DateSerial(2015, ay, gün) ile AL1 e yazdırdım.)


Private Sub TextBox9_Change() 'TARİH SORGULAMA
Dim gün As Byte, ay As Byte
If Len(TextBox9.Text) = 5 And InStr(TextBox9.Text, ".") = 3 Then
gün = Split(TextBox9.Text, ".")(0)
ay = Split(TextBox9.Text, ".")(1)
Range("AL1") = DateSerial(2015, ay, gün)
ActiveSheet.Range("T2.T65500").AutoFilter Field:=20, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
Else
ActiveSheet.Range("T2.T65500").AutoFilter Field:=20
End If
End Sub
 
Ay ve güne göre filtreleme yaptıramadığım için Renge göre filitreleme yaptırmayı denedim. RGB olan kısım kırmızı rengin renk kodları.
Öncelikle A sütunu B1 hücresinin değerine göre koşullu biçimlendirme yapıldı (ay ve günü aynı olanlar koşullu olarak renklendirildi) biçim rengi olarak kırmızı seçildi
Daha sonra A sütununda kırmızı renkli hücreleri filtrele diyerek B1 hücresiyle aynı gün ve aya sahip hücreler filtrelenmiş oldu.

Bir de sadece T sütununa filtre uyguladığınız için Field:=1 yapın.
 
Kodları şu şekilde yaptım ama olmadı. field:=1 de denedim yine olmadı boyama yapmıyor. (field:= 1 yapınca A sütununa göre filtreleme yapıyor.)

Private Sub TextBox9_Change() 'TARİH SORGULAMA
Dim gün As Byte, ay As Byte
If Len(TextBox9.Text) = 5 And InStr(TextBox9.Text, ".") = 3 Then
gün = Split(TextBox9.Text, ".")(0)
ay = Split(TextBox9.Text, ".")(1)
Range("AL1") = DateSerial(2015, ay, gün)
ActiveSheet.Range("T2.T65500").AutoFilter Field:=20, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
Else
ActiveSheet.Range("T2.T65500").AutoFilter Field:=20
End If
End Sub
 
T sütununu seçip koşullu biçimlendirmeden formül kısmına aşağıdaki formülü uygulayarak T sütununda koşullu renklendirme yapabilirsiniz.
Kod:
=VE(GÜN($T1)=GÜN($AL$1);AY($T1)=AY($AL$1))
Koşullu biçimlendirme rengini kırmızı olarak ayarlayın. Koşullu biçimlendirmenin rengine göre kod süzme işlemi gerçekleştirecektir.
Kırmızı yerine farklı bir renk uygulamak isterseniz kod içindeki ilgili yeri de değiştiriniz.
 
Benzer bir mantıkla yardımcı sütun kullanılarak da süzme yapılabilir.
AL1'deki tarihle doğum tarihleri karşılaştırılıp, aynı gün olması durumunda yardımcı bir sütuna herhangi bir veri girilir ve bu sütuna göre süzme işlemi yapılabilir.
 
Siz 2002 excel kullandığınızı imza bölümünüzde belirtmişsiniz. Önerilen kod 2007 ve sonraki versiyonlarda çalışmaktadır. Bunu dikkate almalısınız.
 
Geri
Üst