Listbox'dan Çoklu Seçme

[ahmed_ummu]

Günaydın arkadaşlar.

Aşağıdaki kodu Listbox çoklu seçme için nasıl yapabilirim. Bu haliyle çalışıyor ama Listbox dan birden fazla seçim yaparak işlem yapmak istiyorum. combobox1 in yerine Listbox1 yazarak, birden fazla seçim yaparak enedim. Hata vermedi ama işlemde yapmadı. Yardımcı olursaanız çok sevinirim.

son = s1.Cells(Rows.Count, 2).End(3).Row
baslangic = s1.Range("D5:AO5").Find(s1.Range("AT4")).Column
bitis = s1.Range("D5:AO5").Find(s1.Range("AU4")).Column
For i = 7 To son
If s1.Cells(i, "C").Value = ComboBox1.Value Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next i

 

[halit3]

Öncelikle UserForm_Initialize olayının içine şu kodları koy

ListBox1.Clear
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1

sonra da bunu bir dene

For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next

 

[ahmed_ummu]

Öncelikle UserForm_Initialize olayının içine şu kodları koy

ListBox1.Clear
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1

sonra da bunu bir dene

For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next

For i = 0 To ListBox8.ListCount - 1
If ListBox8.Selected(i) = True Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next

Halit bey kolay gelsin.

Renklendirilmiş satırda, "Application-defined or object-defined error" hatası verdi.

Listboxtan seçilen değerler sayfanın "C" sütununda.

Aşağıdaki kod ile combobox dan tek tek seçim yaparak oluyor ama bir seferde listboxtan çoklu seçim yaparak yapmak istiyorum.

For i = 7 To son
If s1.Cells(i, "C").Value = ComboBox1.Value Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next i

 

[halit3]

kodlarınızın tamamını görmediğim için bir şey diyemem
UserForm_Initialize olayına söylediğim bölümleri eklediyseniz lisbox da toplu seçim yapılabiliyor olmalı
diğer eklemiş olduğunuz kod sizde çalışıyorsa bu bölümdede çalışması lazım.

 

[ahmed_ummu]

kodlarınızın tamamını görmediğim için bir şey diyemem
UserForm_Initialize olayına söylediğim bölümleri eklediyseniz lisbox da toplu seçim yapılabiliyor olmalı
diğer eklemiş olduğunuz kod sizde çalışıyorsa bu bölümdede çalışması lazım.

Halit bey dosyamı ekte gönderdim.

Userform6 da işlem yapılacak.

Frame3 içindeki Commandbutton102 içine kodlar. "Aralığı Sil/Değiştir" isimli buton.

Formdaki combobox ile tek tek seçim yaparak istediğim oluyor ama Listbox dan bir seferde çoklu seçim yaparak olursa çok daha pratik olur.

 

[halit3]

ListBox8.RowSource
yöntemiyle seçili olan bölümü silemezsiniz bunu daha önce size başka mesajlarımda yazmıştım.

ListBox8.RowSource
parametreler sayfasından verileri alıyor siz ise tablo sayfasındaki verileri silmek istiyorsunuz

kodlar bu şekildi silme işlemi yapmaz boş olunca bakmaya çalışacağım.

 

[ahmed_ummu]

ListBox8.RowSource
yöntemiyle seçili olan bölümü silemezsiniz bunu daha önce size başka mesajlarımda yazmıştım.

ListBox8.RowSource
parametreler sayfasından verileri alıyor siz ise tablo sayfasındaki verileri silmek istiyorsunuz

kodlar bu şekildi silme işlemi yapmaz boş olunca bakmaya çalışacağım.

Teşekkürler Halit bey.

 

[halit3]

Bu bölümü ekle diğerini sil

son2 = Sheets("parametreler").Cells(Rows.Count, 2).End(3).Row

ReDim deg(Val(son2))
m = 0
For j = 0 To ListBox8.ListCount - 1
If ListBox8.Selected(j) = True Then
m = m + 1
deg(m) = ListBox8.List(j)
son3 = m
End If
Next j


If m = 0 Then GoTo atla1
For s = 1 To son3
For i = 7 To son
If s1.Cells(i, "C").Value = deg(s) Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next i
Next s
atla1:

 

[ahmed_ummu]

Bu bölümü ekle diğerini sil

son2 = Sheets("parametreler").Cells(Rows.Count, 2).End(3).Row

ReDim deg(Val(son2))
m = 0
For j = 0 To ListBox8.ListCount - 1
If ListBox8.Selected(j) = True Then
m = m + 1
deg(m) = ListBox8.List(j)
son3 = m
End If
Next j


If m = 0 Then GoTo atla1
For s = 1 To son3
For i = 7 To son
If s1.Cells(i, "C").Value = deg(s) Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
End If
Next i
Next s
atla1:

Teşekkürler Halit bey çalışıyor.

Bi de Listbox un altında 7 adet textbox var. Gönderdiğiniz kod ile siliyor ama bazı durumlarda 15 tatil, yıl içindeki 5 er günlük ara tatillerde vb. silinen yerlere ders saatleri girilmesi gerekiyor. Textler boş ise sadece silecek bişey yazmayacak ama textler dolu ise silinen yerlere textlerdeki değerleri yazacak. Mümkün müdür. Böyle de işimi görür o şekilde daha pratik olur.

 

[halit3]

Dosyandaki kodlara pek hakim değilim onun için bir şey diyemiyeceğim.

 

[ahmed_ummu]

Dosyandaki kodlara pek hakim değilim onun için bir şey diyemiyeceğim.

Tamam Halit bey, Elinize sağlık.

 

[ahmed_ummu]

Dosyandaki kodlara pek hakim değilim onun için bir şey diyemiyeceğim.

Halit bey sizin gönderdiğiniz kodlara Renkli kodları ekleyince oldu.

son2 = Sheets("parametreler").Cells(Rows.Count, 2).End(3).Row
ReDim deg(Val(son2))
m = 0
For j = 0 To ListBox8.ListCount - 1
If ListBox8.Selected(j) = True Then
m = m + 1
deg(m) = ListBox8.List(j)
son3 = m
End If
Next j
If m = 0 Then GoTo atla1
For s = 1 To son3
For i = 7 To son
If s1.Cells(i, "C").Value = deg(s) Then
s1.Range(s1.Cells(i, baslangic), s1.Cells(i, bitis)).ClearContents
s1.Cells(i, baslangic).Value = TextBox45.Value
s1.Cells(i, baslangic + 1).Value = TextBox46.Value
s1.Cells(i, baslangic + 2).Value = TextBox47.Value
s1.Cells(i, baslangic + 3).Value = TextBox48.Value
s1.Cells(i, baslangic + 4).Value = TextBox49.Value
s1.Cells(i, baslangic + 5).Value = TextBox50.Value
s1.Cells(i, baslangic + 6).Value = TextBox51.Value
End If
Next i
Next s
atla1: