• DİKKAT

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

listbox birleştirme

xemdarx

xemdarx

Katılım
11 Şubat 2010
Mesajlar
202
Excel Vers. ve Dili
13 türkçe
Merhaba, şu iki kodu listboxta nasıl birleştirebilirim...Sadece listboxta isim seçince ikisi de ayrı çalışsın...Veya şu şekilde yardımcı olabilir misniz? Listboxta isim seçince hem userforma gelsin veriler hemde başka seçtiğim hücrelere gelsin.Teşekkürler

Kod: 
Private Sub ListBox1_Click()
TextBox1 = ListBox1
For Each bul In Range("B1:B" & WorksheetFunction.CountA([b1:b65536]))
If StrConv(bul, vbUpperCase) = StrConv(TextBox1, vbUpperCase) Then
bul.Select
TextBox1 = ActiveCell.Offset(0, 0)
TextBox2 = ActiveCell.Offset(0, 1)
TextBox3 = ActiveCell.Offset(0, 2)
TextBox4 = ActiveCell.Offset(0, 3)
TextBox5 = ActiveCell.Offset(0, 4)
TextBox6 = ActiveCell.Offset(0, 5)
TextBox7 = ActiveCell.Offset(0, 6)
TextBox8 = ActiveCell.Offset(0, 7)
TextBox9 = ActiveCell.Offset(0, 8)
TextBox10 = ActiveCell.Offset(0, 9)
TextBox11 = ActiveCell.Offset(0, 10)
TextBox12 = ActiveCell.Offset(0, 11)
TextBox13 = ActiveCell.Offset(0, 12)
End If
Next
Kod: 
Private Sub ListBox1_Click()
Dim bulx As Range
For Each bulx In Sayfa1.Range("b2:b" & Sayfa1.Range("b65536").End(3).Row)
If bulx.Value = ListBox1.Value Then

Range("T1") = bulx.Offset(0, 0).Value
Range("U1") = bulx.Offset(0, 1).Value
Range("V1") = bulx.Offset(0, 2).Value
Range("W1") = bulx.Offset(0, 3).Value
Range("X1") = bulx.Offset(0, 4).Value
Range("Y1") = bulx.Offset(0, 5).Value
Range("Z1") = bulx.Offset(0, 6).Value
Range("AA1") = bulx.Offset(0, 7).Value
Range("AB1") = bulx.Offset(0, 8).Value
Range("AC1") = bulx.Offset(0, 9).Value
Range("AD1") = bulx.Offset(0, 10).Value
Range("AE1") = bulx.Offset(0, 11).Value
Range("AF1") = bulx.Offset(0, 12).Value
End If
Next bulx
Set bulx = Nothing
End Sub
 
Dosyanızı eklerseniz çözüme bakabiliriz.
 
Konuyu ekte açıkladım lütfen yardımcı olunuz. Teşekkürler
 

Ekli dosyalar

Referanslardan dolayı sanırım hata veriyor. Dosyayı tam açamıyorum. Referans kısmı da şifrelenmiş. Missing referansı varsa kaldırıp tekrar yüklerseniz ya da şifreyi kaldırıp.
 
Dosyanızı 2-3 kere indirdim. Ama benim bilgisayarımda form açılmadı. Hata verdi o yüzden işlem yapamadım. Başka bir arkadaş ilgilenirse. (Userform üzerinde standart form elemanları haricinde listview vb olduğu zaman işlem yapmıyor. Office 64 bit olduğu için)
 
Aşağıdaki kodları deneyin.
Kod: 
Private Sub ListBox1_Click()
TextBox1 = ListBox1
ActiveSheet.Unprotect "123"
For Each Bul In Range("B1:B" & WorksheetFunction.CountA([b1:b65536]))
If StrConv(Bul, vbUpperCase) = StrConv(TextBox1, vbUpperCase) Then
Satir = Bul.Row
TextBox1 = Cells(Satir, 2)
TextBox2 = Cells(Satir, 3)
TextBox3 = Cells(Satir, 4)
TextBox4 = Cells(Satir, 5)
TextBox5 = Cells(Satir, 6)
TextBox6 = Cells(Satir, 7)
TextBox7 = Cells(Satir, 8)
[s1] = Cells(Satir, 1)
[T1] = Cells(Satir, 2)
[U1] = Cells(Satir, 3)
[V1] = Cells(Satir, 4)
[W1] = Cells(Satir, 5)
[X1] = Cells(Satir, 6)
[Y1] = Cells(Satir, 7)
[Z1] = Cells(Satir, 8)
End If
Next
ActiveSheet.Protect "123"
End Sub
 
Teşekkür ederim emek verdiniz. Maalesef istedeğim gibi olmadı. Değiştir dediğimde dosya farklı yere kaydediyor tabloyu.
 
Merhaba
Dosyanıza bakma imkanım yok ama
Listeye gelen ve döngü ile arama yapılan sayfa aynı ise kodlar şöyle olabilir.
Olmazsa bir örnek dosya eklermisiniz? www.dosya.tc
Kod: 
 [SIZE="2"]Private Sub ListBox1_Click()
TextBox1 = ListBox1
For Each bul In Range("b2:b" & Sayfa1.Range("b65536").End(3).Row)
If StrConv(bul, vbUpperCase) = StrConv(TextBox1, vbUpperCase) Then
For t = 0 To 12
Controls("TextBox" & t + 1) = Cells(bul.Row, bul.Column + t)
Next
Range("T1:AF1").Value = Range("B" & bul.Row & ":N" & bul.Row).Value
End If
Next
End Sub[/SIZE]
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst