Soru Listboxdaki Bilgiyi Hücreye yazdırma.

[pckatil]

Merhaba arkadaşlar. Yapmış olduğum excelde Personel listesinden seçtiğim isimleri Hangi projenin güncelle butonuna bastığında oraya atmasını istiyorum ve hangi projede iste B Hücresinde yanına projesinin ismini yazdırmak istiyorum. Birde eğer personel 2. bir projeye eklenmeye çalıştığında uyarı vermesini "Personel Başka Projede Görevli" şeklinde. Yardımcı olabilirseniz Sevinirim. Teşekkürler.

 

[YUSUF44]

Öncelikle LbPersonel listboxunuzun özelliklerinden Listfillrange'deki Personel ifadesini silin, boş kalsın. Yeni isimler eklenebilmesi için boş olması gerekiyor.

Sonra ekle1_click kodlarını aşağıdakilerle değiştirin. Böylece Textbox1'e yazdığınız isim personel listesinde varsa kayıt yapmaz, yoksa hem personel listesine hem de listboxa ekler:

Private Sub ekle1_Click()
Dim Mutlu As Long, Say As Byte

Mutlu = Range("A65536").End(3).Row + 1
If WorksheetFunction.CountIf(Range("A1:A" & Mutlu), TextBox1.Text) = 0 Then
    Cells(Mutlu, "A") = TextBox1.Text
    LbPersonel.List = Range("A1:A" & Mutlu).Value
    TextBox1.Value = ""
Else
    MsgBox TextBox1.Text & " adlı personel zaten mevcuttur!", vbExclamation
    TextBox1.Value = ""
End If
End Sub

Birinci proje için CBProje1_Click kodlarını aşağıdakiyle değiştirin. Bu kodla listboxtaki seçili isimler sırasıyla kontrol edilir, B sütununda o kişinin karşısında proje yazıyorsa uyarı verir, karşısı boşsa birinci projeye ekler ve B sütununa proje adını yazar. Diğer projeler için kodları güncelleyin:

Private Sub CbProje1_Click()
son = Range("A65536").End(3).Row
For i = 0 To LbPersonel.ListCount - 1
    If LbPersonel.Selected(i) Then
        If WorksheetFunction.VLookup(LbPersonel.List(i), Range("A1:B" & son), 2, 0) = "" Then
            LbProje1.AddItem LbPersonel.List(i)
            sat = WorksheetFunction.Match(LbPersonel.List(i), Range("A1:A" & son), 0)
            Cells(sat, "B") = "Proje 1"
        Else
            sat = WorksheetFunction.Match(LbPersonel.List(i), Range("A1:A" & son), 0)
            MsgBox LbPersonel.List(i) & " adlı personel " & Cells(sat, "B") & " projesinde görevlidir!", vbExclamation
        End If
    End If
Next i
End Sub