• DİKKAT

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

Listbox 10 sınırını aşamıyorum...

J

jilazem

Altın Üye
Katılım
17 Temmuz 2007
Mesajlar
26
Excel Vers. ve Dili
2013 x64
Altın Üyelik Bitiş Tarihi
25-09-2026
Merhaba
Ekte bulunan dosyada listbox da 10 adet sınırı mevcut olup sınırı aşamamaktayım. Yaklaşık 50-60 adet text ve combo box ekleyeceğim ama çözemiyorum.Kod bilgim çok alt seviyede yardımlarını bekliyorum.
rowsource ile yüklemeyi nasıl yapacağımı çözemedim :(
Ek olarak kodlarda sadeleştirme yapmak istiyorum örn: TP1,TP2...TP10 isimli textbox oluşturdum her seferişnde tekrar yazmak zorundayım döngü oluşturamadım :(

Kod: 
Private Sub CommandButton1_Click()
Dim sat, son, deg, s As Integer
'mükerrer kontrol
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "b") = TP1 Then
MsgBox "Bu isimden daha önce girilmiş", vbInformation

TP1 = Empty:
TP2 = Empty:
TP3 = Empty:
TP4 = Empty:
TP5 = Empty:
TP6 = Empty:
TP7 = Empty:
TP8 = Empty:
TP9 = Empty:
TP10 = Empty:
TP11 = Empty:
TP12 = Empty:
TP13 = Empty:
TP14 = Empty:
Exit Sub: End If: Next
'*****verigir
If TP1 = "" Then MsgBox "Önce isim girmelisiniz", vbInformation: Exit Sub
son = Cells(65536, "b").End(xlUp).Row + 1
Cells(son, "b") = TP1
Cells(son, "c") = TP2
Cells(son, "d") = TP3
Cells(son, "e") = TP4
Cells(son, "f") = TP5
Cells(son, "g") = TP6
Cells(son, "h") = TP7
Cells(son, "i") = TP8
Cells(son, "j") = TP9
Cells(son, "k") = TP10
Cells(son, "l") = TP11
Cells(son, "m") = TP12
Cells(son, "n") = TP13
Cells(son, "o") = TP14

TP1 = Empty:
TP2 = Empty:
TP3 = Empty:
TP4 = Empty:
TP5 = Empty:
TP6 = Empty:
TP7 = Empty:
TP8 = Empty:
TP9 = Empty:
TP10 = Empty:
TP11 = Empty:
TP12 = Empty:
TP13 = Empty:
TP14 = Empty:



'*****sıranover
[a2:a65536] = Empty
deg = WorksheetFunction.CountA(Range("b2:b65536"))
s = 1
Do While [b2] <> ""
Cells(s + 1, "a") = s
s = s + 1
If s > deg Then Exit Do
Loop
'***** listboxu yenile
Textbul = ".": Textbul = ""
End Sub
Private Sub CommandButton2_Click()
Dim sat As Integer
'*****listbox seçili değilse uyar
If ListBox1.ListIndex < 0 Then
MsgBox "Önce bir isim seçmelisiniz", vbInformation
Exit Sub: End If
'*****değişecek verileri döngü ile kontrol et
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "a") Like ListBox1.Column(0) Then
Cells(sat, "b") = TP1
Cells(sat, "c") = TP2
Cells(sat, "d") = TP3
Cells(sat, "e") = TP4
Cells(sat, "f") = TP5
Cells(sat, "g") = TP6
Cells(sat, "h") = TP7
Cells(sat, "i") = TP8
Cells(sat, "j") = TP9
Cells(sat, "k") = TP10
Cells(sat, "l") = TP11
Cells(sat, "m") = TP12
Cells(sat, "n") = TP13
Cells(sat, "o") = TP14
End If: Next
'değişim sonu textleri temizle
TP1 = Empty:
TP2 = Empty:
TP3 = Empty:
TP4 = Empty:
TP5 = Empty:
TP6 = Empty:
TP7 = Empty:
TP8 = Empty:
TP9 = Empty:
TP10 = Empty:
TP11 = Empty:
TP12 = Empty:
TP13 = Empty:
TP14 = Empty:
'***** listboxu yenile
Textbul = ".": Textbul = ""
End Sub
Private Sub CommandButton3_Click()
Dim sat As Integer
'*****listbox seçili değilse uyar
If ListBox1.ListIndex < 0 Then
MsgBox "Önce listeden bir isim seçiniz", vbInformation
Exit Sub: End If
'*****silinecek verileri döngü ile kontrol et
For sat = 2 To Cells(65536, "a").End(xlUp).Row
If Cells(sat, "a") Like ListBox1.Column(0) Then
Cells(sat, "a").EntireRow.Delete shift:=xlUp
End If: Next
'***** listboxu yenile
Textbul = ".": Textbul = ""
'değişim sonu textleri temizle
TP1 = Empty:
TP2 = Empty:
TP3 = Empty:
TP4 = Empty:
TP5 = Empty:
TP6 = Empty:
TP7 = Empty:
TP8 = Empty:
TP9 = Empty:
TP10 = Empty:
TP11 = Empty:
TP12 = Empty:
TP13 = Empty:
TP14 = Empty:
End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label2_Click()

End Sub

Private Sub ListBox1_Click()
'textlere listboxtan veri al
TP1 = ListBox1.Column(1):
TP2 = ListBox1.Column(2):
TP3 = ListBox1.Column(3):
TP4 = ListBox1.Column(4):
TP5 = ListBox1.Column(5):
TP6 = ListBox1.Column(6):
TP7 = ListBox1.Column(7):
TP8 = ListBox1.Column(8):
TP9 = ListBox1.Column(9):
'TP10 = ListBox1.Column(10):
'TP11 = ListBox1.Column(11):
'TP12 = ListBox1.Column(12):
'TP13 = ListBox1.Column(13):
'TP14 = ListBox1.Column(14):
End Sub

Private Sub TabStrip1_Change()

End Sub

Private Sub MultiPage1_Change()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub Textbul_Change()
Dim sat, s As Integer
Dim deg1, deg2 As String
With ListBox1
.Clear
.ColumnCount = 10
.ColumnWidths = "30,75,75,75,75,75,75,75,75,75,75"
End With
For sat = 2 To Cells(65536, "b").End(xlUp).Row
deg1 = UCase(Replace(Replace(Cells(sat, "b"), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(Textbul, "ı", "I"), "i", "İ"))
If deg1 Like "*" & deg2 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "a")
ListBox1.List(s, 1) = Cells(sat, "b")
ListBox1.List(s, 2) = Cells(sat, "c")
ListBox1.List(s, 3) = Cells(sat, "d")
ListBox1.List(s, 4) = Cells(sat, "e")
ListBox1.List(s, 5) = Cells(sat, "f")
ListBox1.List(s, 6) = Cells(sat, "g")
ListBox1.List(s, 7) = Cells(sat, "h")
ListBox1.List(s, 8) = Cells(sat, "i")
ListBox1.List(s, 9) = Cells(sat, "j")
'ListBox1.List(s, 10) = Cells(sat, "k")
'ListBox1.List(s, 11) = Cells(sat, "l")
'ListBox1.List(s, 12) = Cells(sat, "m")
'ListBox1.List(s, 13) = Cells(sat, "n")
'ListBox1.List(s, 14) = Cells(sat, "o")
s = s + 1
End If: Next
End Sub
Private Sub UserForm_Initialize()
'***** listboxu yenile
Textbul = ".": Textbul = ""
LL1 = [a1]:
LL2 = [b1]:
LL3 = [c1]:
LL4 = [d1]:
LL5 = [g1]:
LL6 = [h1]:
LL7 = [l1]:
LL8 = [m1]:
LL9 = [n1]:
LL10 = [o1]:
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,563
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Forumda listbox+redim ifadesi ile arama yapınız.

Örnek kodlara ulaşacaksınız.
 
J

jilazem

Altın Üye
Katılım
17 Temmuz 2007
Mesajlar
26
Excel Vers. ve Dili
2013 x64
Altın Üyelik Bitiş Tarihi
25-09-2026
Korhan Ayhan' Alıntı:
Forumda listbox+redim ifadesi ile arama yapınız.

Örnek kodlara ulaşacaksınız.
Genişletmek için tıkla ...
Çok teşekkür ederim, dediğiniz gibi forumda arama yaptığımda aşağıdaki kod ile sorunu çözebildim :) artık 10 sorunu aşıldı ama şimdide textbul arama/filtre yapmıyor nerede hatam olabilir?

Kod: 
Private Sub Textbul_Change()
Dim sat, s As Integer
Dim deg1, deg2 As String
With ListBox1
.Clear
.ColumnCount = 10
.ColumnWidths = "30,75,75,75,75,75,75,75,75,75,75"
End With
For sat = 2 To Cells(65536, "b").End(xlUp).Row
deg1 = UCase(Replace(Replace(Cells(sat, "b"), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(Textbul, "ı", "I"), "i", "İ"))
If deg1 Like "*" & deg2 & "*" Then
'ListBox1.AddItem
'ListBox1.List(s, 0) = Cells(sat, "a")
'ListBox1.List(s, 1) = Cells(sat, "b")
'ListBox1.List(s, 2) = Cells(sat, "c")
'ListBox1.List(s, 3) = Cells(sat, "d")
'ListBox1.List(s, 4) = Cells(sat, "e")
'ListBox1.List(s, 5) = Cells(sat, "f")
'ListBox1.List(s, 6) = Cells(sat, "g")
'ListBox1.List(s, 7) = Cells(sat, "h")
'ListBox1.List(s, 8) = Cells(sat, "i")
'ListBox1.List(s, 9) = Cells(sat, "j")
'ListBox1.List(s, 10) = Cells(sat, "k")
'ListBox1.List(s, 11) = Cells(sat, "l")
'ListBox1.List(s, 12) = Cells(sat, "m")
'ListBox1.List(s, 13) = Cells(sat, "n")
'ListBox1.List(s, 14) = Cells(sat, "o")

ListBox1.ColumnCount = 14
ListBox1.List = Range("A2:O" & Cells(65536, "A").End(xlUp).Row).Value
s = s + 1
End If: Next
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,563
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Yine aynı şekilde forumda textbox+listbox ifadeleri ile arama yapınız.

Örneklere ulaşabilirsiniz.
 
J

jilazem

Altın Üye
Katılım
17 Temmuz 2007
Mesajlar
26
Excel Vers. ve Dili
2013 x64
Altın Üyelik Bitiş Tarihi
25-09-2026
Korhan Ayhan' Alıntı:
Aşağıdaki linki inceleyiniz.

Listboxta filtre uygulaması
Genişletmek için tıkla ...
Korhan Bey verdiğiniz linkleri inceledim ama bende kod yazılımı ve mantığı ile ilgili bilgi eksikliği mevcut;

Kod: 
Private Sub Textbul_Change()
Dim sat, s As Integer
Dim deg1, deg2 As String
With ListBox1
.Clear
.ColumnCount = 10
.ColumnWidths = "30,75,75,75,75,75,75,75,75,75,75"
End With
For sat = 2 To Cells(65536, "b").End(xlUp).Row
deg1 = UCase(Replace(Replace(Cells(sat, "b"), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(Textbul, "ı", "I"), "i", "İ"))
If deg1 Like "*" & deg2 & "*" Then
Kod: 
'ListBox1.AddItem
'ListBox1.List(s, 0) = Cells(sat, "a")
'ListBox1.List(s, 1) = Cells(sat, "b")
'ListBox1.List(s, 2) = Cells(sat, "c")
'ListBox1.List(s, 3) = Cells(sat, "d")
'ListBox1.List(s, 4) = Cells(sat, "e")
'ListBox1.List(s, 5) = Cells(sat, "f")
'ListBox1.List(s, 6) = Cells(sat, "g")
'ListBox1.List(s, 7) = Cells(sat, "h")
'ListBox1.List(s, 8) = Cells(sat, "i")
'ListBox1.List(s, 9) = Cells(sat, "j")
'ListBox1.List(s, 10) = Cells(sat, "k")
'ListBox1.List(s, 11) = Cells(sat, "l")
'ListBox1.List(s, 12) = Cells(sat, "m")
'ListBox1.List(s, 13) = Cells(sat, "n")
'ListBox1.List(s, 14) = Cells(sat, "o")
additem kullandığımda sorun yok fakat 10 adet sınırı mevcut

Kod: 
ListBox1.ColumnCount = 14
ListBox1.List = Range("A2:O" & Cells(65536, "A").End(xlUp).Row).Value
additem yerine range kullandığımda sorun 10 adet sorunu çözülüyor fakat filtreleme yapmıyor.
Kod: 
s = s + 1
End If: Next
End Sub
Sorunum additem ile verilmiş yapıyı range ile yapılmış yapıya adapte edebilmek.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst