![[Resim: do.php?img=11047]](https://resim.accesstr.net/do.php?img=11047)
https://resim.accesstr.net/do.php?img=11047
Merhaba.
(16/05/2021, 03:21)Jer Fin yazdı: ayrıca bölümünde bölümde kategori ismi içindeki kelimeleri de ararsa sevinirim.
Kategori ismi yok sayfada onun yerine County olarak örnek ekledim.Kod altta ordaki County yerini değiştirin.
Ayrıca Private Sub UserForm_Initialize() içindeki .AddItem Sheets("Data").Range("E1").Value bunuda değiştirin ben ekledim County başlık için.
Field:=5 burdaki 5 demek 5. sütundur Kategori isimi hangi sütunda ise onun sütun numarası ile değiştirin.
'------------------------------------------------
Case "County"
ActiveSheet.AutoFilterMode = False
ListBox1.Clear
ActiveSheet.Range("A1:O" & Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=5, Criteria1:=TextBox13.Value & "*", Operator:=xlAnd
Sheets("FilteredData").Cells.Clear
If ActiveSheet.Range("A1").CurrentRegion.Columns(1).SpecialCells(xlCellTypeVisible).Count <= 1 Then
GoTo here5:
Else
ActiveSheet.Range("A2:O" & Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("FilteredData").Range("A2")
End If
Sheets("FilteredData").Columns.AutoFit
ListBox1.List = Sheets("FilteredData").Range("A2:O" & Sheets("FilteredData").Cells(Rows.Count, 1).End(xlUp).Row).Value
here5:
ActiveSheet.AutoFilterMode = False
Call Clear
'------------------------------------------------
Listbox tıklama kodundaki TextBox1.Value = ListBox1.Column(0) gibi yerleri devam edin doldurun ben 3 adet ekledim koda.
Private Sub ListBox1_Click()
Dim say, lastrow As Long, a As Byte
'ListBox1.MultiSelect = 0
OptionButton1.Value = True
image1Temizle
TextBox1.Value = ListBox1.Column(0) 'Listbox1 ilk sütun
TextBox2.Value = ListBox1.Column(1)
TextBox3.Value = ListBox1.Column(2)
lastrow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Data").Activate
Sheets("Data").Range("A2:A" & lastrow).Find(What:=ListBox1.Value, LookIn:=xlValues, Lookat:=xlWhole).Activate
say = ActiveCell.Row
TextBox15.Value = say
Sheets("Data").Range("A" & say & ":O" & say).Select
End Sub
Ayrıca alttaki yazdıklarınız dosyada yok o yüzden anlamadım.
Son olarak ürün kodu ile değil 1 arasında kutucuğa mutlaka veri girmek gerekiyor.
onun kutucuğa veri girmek zorunda kalmayayım. ve Tahmini Gelir kutucuğu sadece rakam girmek zorunluluğu kaldırılırsa sevinirim.
Criteria1:=TextBox13.Value & "*"
Yukardaki yerine alttaki gibi olursa içerisinde olarak arar.
Kodda birçok yerde var.
Criteria1:="*" & TextBox13.Value & "*"
USER FORM X.rar
(Dosya Boyutu: 297,69 KB | İndirme Sayısı: 9)
#1
USER FORM X.zip
(Dosya Boyutu: 489,81 KB | İndirme Sayısı: 4)
