Soru İki tarih ve sayı değeri arasında textbox ile süzme yapma

[hamza2011]

Merhaba,
Ek' li dosyada paylaştığım dosyada;

"Sıcak Kalınlık", "Sıcak Genişlik", "Ağırlık" ve "Üretim Tarihi" adlı textboxlara gireceğim değere göre "büyük veya eşit", "küçük veya eşit" aralığında süzme işlemi yaptırmak istiyorum.

Değerli yardımlarınızı rica ediyorum.

 

[Ömer BARAN]

Merhaba.

-- Sayfada KALINLIK, GENİŞLİK, AĞIRLIK ve TARİH için konumlandırdığınız TEXTBOX nesnelerinin herbirinin
...Change kod blokunu aşağıdaki kod gibi değiştirin.
-- Ardından da uygun bir MODÜL'e aşağıdaki kod blokunu yapıştırın.
NOT:
-- Verdiğim cevapta ADRES ve sayfanın SOL TARAFındaki TEXTBOX nesneleriyle ilgili herhangi bir işlem mevcut değildir.
-- Tarih TEXTBOX'ları için GG/AA/YYYY şeklinde 10 karakterli tarih girildiğinde işlem yapılır.

Private Sub TextBox6_Change()
    BARAN
End Sub

Sub BARAN()

If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
son = ActiveSheet.Cells(Rows.Count, 1).End(3).Row
If ActiveSheet.TextBox7 <> "" Then kr71 = ">=" & Replace(ActiveSheet.TextBox7, ",", ".")
If ActiveSheet.TextBox7 = "" Then kr71 = ">=" & Replace(WorksheetFunction.Min(Range("G10:G" & son)), ",", ".")
    
If ActiveSheet.TextBox8 <> "" Then kr72 = "<=" & Replace(ActiveSheet.TextBox8, ",", ".")
If ActiveSheet.TextBox8 = "" Then kr72 = "<=" & Replace(WorksheetFunction.Max(Range("G10:G" & son)), ",", ".")
    
    
If ActiveSheet.TextBox12 <> "" Then kr81 = ">=" & Replace(ActiveSheet.TextBox12, ",", ".")
If ActiveSheet.TextBox12 = "" Then kr81 = ">=" & Replace(WorksheetFunction.Min(Range("H10:H" & son)), ",", ".")
    
If ActiveSheet.TextBox13 <> "" Then kr82 = "<=" & Replace(ActiveSheet.TextBox13, ",", ".")
If ActiveSheet.TextBox13 = "" Then kr82 = "<=" & Replace(WorksheetFunction.Max(Range("H10:H" & son)), ",", ".")
    
If ActiveSheet.TextBox6 <> "" Then kr61 = Replace(ActiveSheet.TextBox6, ",", ".")
If ActiveSheet.TextBox6 = "" Then kr61 = ">=" & Replace(WorksheetFunction.Min(Range("F10:F" & son)), ",", ".")
    
If ActiveSheet.TextBox14 <> "" Then kr62 = "<=" & Replace(ActiveSheet.TextBox14, ",", ".")
If ActiveSheet.TextBox14 = "" Then kr62 = "<=" & Replace(WorksheetFunction.Max(Range("F10:F" & son)), ",", ".")

If Len(ActiveSheet.TextBox9) = 10 Then kr181 = ">=" & CLng(CDate(ActiveSheet.TextBox9.Text))
If Len(ActiveSheet.TextBox9) <> 10 Then kr181 = ">=" & WorksheetFunction.Min(Range("R10:R" & son))
    
If Len(ActiveSheet.TextBox15) = 10 Then kr182 = "<=" & CLng(CDate(ActiveSheet.TextBox15))
If Len(ActiveSheet.TextBox15) <> 10 Then kr182 = "<=" & WorksheetFunction.Max(Range("R10:R" & son))


    ActiveSheet.Range("A9:Z" & son).AutoFilter Field:=6, Criteria1:=kr61, Operator:=xlAnd, Criteria2:=kr62
    ActiveSheet.Range("A9:Z" & son).AutoFilter Field:=7, Criteria1:=kr71, Operator:=xlAnd, Criteria2:=kr72
    ActiveSheet.Range("A9:Z" & son).AutoFilter Field:=8, Criteria1:=kr81, Operator:=xlAnd, Criteria2:=kr82
    ActiveSheet.Range("A9:Z" & son).AutoFilter Field:=18, Criteria1:=kr181, Operator:=xlAnd, Criteria2:=kr182

End Sub

 

[hamza2011]

Ömer Hocam;
Evet hatırladım, yanılmıyorsam iş yerimde toplantı sırasında açmıştım. Aksi halde cevap yazıyorum. Özrümü kabul edin lütfen!

 

[Ömer BARAN]

Estağfurullah, "özür"lük bir durum yok.
Konu sahibinin ihtiyacı tam olarak karşılanmamışsa veya cevabımda sorun varsa konuyla tekrar ilgilenmek istmemle ilgili bir durum.
Kolay gelsin.
.