Selamlar sevgili üstatlarım;
Sizden ricam bu
Excel ortam kitapçığını düzenlememe yardım etmeniz gerekir.
Ben bu exceli internetten indirdim.
Resim yolu sekmesine: buton ekle ve tex kutusuna seçeceğim resim yolunu Eklemek ve o resmi boş kutucuğa resmi yerleştirmek.
oraya bir kaç resmi seçmek ve aşağıdaki gibi Eklemek
"C: \ Kullanıcılar \ admin \ Resimler \ Film Rulosu"; "C: \ Kullanıcılar \ admin \ Resimler"; ...... gibi
ayrıca bölümünde bölümde kategori ismi içindeki kelimeleri de ararsa sevinirim.
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.
https://www.dropbox.com/scl/fi/716xn5zpu...wk7ldao8qi
https://s5.dosya.tc/server3/i08uuh/vba_u...sm&3176589
[url=https://ibb.co/gtd2Yhn][/url]
https://ibb.co/gtd2Yhn
bu adım çalışıyorum
indirdiğim orjinal site
https://merkez-ihayat.blogspot.com/2016/...-more.html
![[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 & "*"
Geri dönüş olmadığı için taşınmıştır.
(18/05/2021, 00:31)feraz yazdı: [ -> ]
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 & "*"
(23/05/2021, 18:16)Jer Fin yazdı: [ -> ] (18/05/2021, 00:31)feraz yazdı: [ -> ]
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 & "*"
Teşekkürler yardımınız için