• DİKKAT

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

Sicile göre ve isme göre personel getirme

Katılım
15 Temmuz 2012
Mesajlar
2,802
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba arkadaşlar herkese hayırlı geceler.

Ekte gönderdiğim excel sayfamda sicil yazarak personelin ismini personel sayfasından düşeyara formülü ile getiriyorum. Arkadaşlar bazen formülü siliyorlar buda bazı hatalara neden oluyor.

Personellerin görevlendirmesinde elle yazıldığında fazla boşluk verme, ismi yanlış yazma, sicili yanlış yazma durumlarında bu personellerin görevlerinin toplamlarında hata oluşuyor.

GÖREVLENDİRME sayfasının B sütununda sicil yazdığımda C sütununa PERSONEL listesindeki sicil karşılığındaki ismin gelmesini istiyorum, ayrıca bu işlemin tersi olan C sütununa personel ismini yazdığım zaman B sütununa ilgili personelin sicilinin gelmesini istiyorum.

Önceki örneklere göre yapmaya çalıştım ancak başaramadım.
Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
Merhaba.

Sicil yazıldığında ad soyad, ad soyad yazıldığında da sicil kod tarafından tamamlanır.
GÖREVLENDİRME sayfasının kod bölümüne uygulayınız.
İstediğiniz şeyi tam karşılayıp karşılamadığını belirtirsiniz.
.
Kod:
[FONT="Arial Narrow"]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:C]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If Target.Column = 2 And Cells(Target.Row, 3) = "" Then
    If WorksheetFunction.CountIf(Sheets("PERSONEL").Range("A:A"), Target) = 0 Then
        MsgBox "Yazılan Sicil Numarası PERSONEL LİSTESİNDE YOK," & vbLf & _
                "Kontrol Ederek Tekrar Yazınız."
        Target = "": Exit Sub
    End If
    sicil = WorksheetFunction.Match(Target, Sheets("PERSONEL").Range("A:A"), 0)
    Cells(Target.Row, 3) = Sheets("PERSONEL").Cells(sicil, 2): Exit Sub
End If

If Target.Column = 3 And Cells(Target.Row, 2) = "" Then
    If WorksheetFunction.CountIf(Sheets("PERSONEL").Range("B:B"), Target) = 0 Then
        MsgBox "Yazılan Ad Soyad PERSONEL LİSTESİNDE YOK," & vbLf & _
                "Kontrol Ederek Tekrar Yazınız."
        Target = "": Exit Sub
    End If
    adı = WorksheetFunction.Match(Target, Sheets("PERSONEL").Range("B:B"), 0)
    Cells(Target.Row, 2) = Sheets("PERSONEL").Cells(adı, 1): Exit Sub
End If
End Sub[/FONT]
 
Sayın Ömer Bey valla tam istediğim gibi olmuş ellerinize ve emeğinize sağlık, hayırlı geceler diliyorum.
 
Geri
Üst