giriş çıkış tablosu hk. (Acil)

Katılım
31 Aralık 2011
Mesajlar
1
Excel Vers. ve Dili
2007
Merhaba ,
Ben bir tablo oluşturmak istiyorum

kod isim tarih saat
1453 can bu gün sistem saati
1454 mehmet bu gün sistem saati,

yukarıdaki gibi mesela a1 e 1453 yazdığımda b1 de can yazsın, c1 de o günün tarihi çıksın, d1 dede sistem saati çıksın istiyorum. Ayrıca 1453 yazdığımda sütunlar kırmızı , 1454 yazdığımda farklı olsunlar istiyorum . yardımcı olursanız sevinirim. Çok acil lazım. Exelde yeniyim. Şimdiden teşekkürler
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,496
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Dosyayı inceleyiniz.

VeriGiris sayfasında a sütununa yazılan koddan sonra diğer sütunlar otomatik doldurulur ve renklendirilir. Renklendirme yine aynı sayfada F2 hücresine yazdığınız renk kodu ile olur.

Bu sayfadaki kodlar :

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [A:A,F2]) Is Nothing Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Value = "" Then Range("B" & Target.Row & ":D" & Target.Row).ClearContents
    Dim c   As Range
    Dim sp  As Worksheet
    Dim Kal As Integer
    
    Set sp = Sheets("Personel")
    If Target.Column = 6 Then
        Range("F2").Interior.ColorIndex = Range("F2").Value
    Else
        Set c = sp.Range("A:A").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Target.Offset(0, 1) = sp.Cells(c.Row, "B")
        Else
            Target.Offset(0, 1) = "***Bulamadım***"
        End If
        Target.Offset(0, 2) = Date
        Target.Offset(0, 3) = Time
        Kal = Target.Row Mod 2
        If Kal = 1 Then Range("A" & Target.Row & ":D" & Target.Row).Interior.ColorIndex = [F2]
    End If
Son:
End Sub
İsimleri Personel sayfasında yazmalısınız.

Renkler sayfasında renk kodlarını görebilirsiniz.
Bu sayfada herhangi bir hücreye çift tıklarsanız renk kodlarını ve renkler listelenir. Kodlar yine bu sayfanın kod bölümünde olmalı.

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Integer
    For i = 1 To 56
        Cells(i + 1, "A") = i
        Cells(i + 1, "B").Interior.ColorIndex = i
    Next i
End Sub
 

Ekli dosyalar

Üst