Günü gelen personeli uyarı vermesi

[Astalavista58]

Merhabalar herkese hayırlı günler dilerim, bir konuda yardımınıza ihtiyacım var. Ekteki exceli her açtığımda, tarihi bugün olan personeli, “ADI – SOYAD- TARİH VE AÇIKLAMAYI” birleştirerek her açtığım da uyarı vermesini istiyorum.

Örneğin, "MAHMUT AHMET - 16.09.2022 - HASTANEYE SEVK EDİLECEK" gibi.

 

[kulomer46]

Merhaba

Dosyanızının isminin sonu .xlsm.xls şeklinde olduğundan dosyanızı açamadım.

Dosyanızı tekrar yüklermisiniz.

Selamlar..

 

[Astalavista58]

Merhaba

Dosyanızının isminin sonu .xlsm.xls şeklinde olduğundan dosyanızı açamadım.

Dosyanızı tekrar yüklermisiniz.

Selamlar..

Neden öyle olduğunu anlamadım, düzeltip tekrar ekledim

 

[AdemCan]

Merhaba, günü gelen personeli başka bir sayfada göstermek için örnek.
Dosyaya bir sayfa ekleyip kodları Thisworkbook bölümüne yapıştırınız.
Dosya her açıldığında bu sayfaya kayıt yapar.

Private Sub Workbook_Open()
Dim s1 As Worksheet, s2 As Worksheet
Dim s1s As Long, s2s As Long, i As Long, x As Long
Set s1 = Sayfa1: Set s2 = Sayfa2
s1s = s1.Cells(Rows.Count, 2).End(3).Row
s2s = s2.Cells(Rows.Count, 2).End(3).Row
s2.Range("A2:E" & s2s + 1).Clear
x = 1
For i = 2 To s1s
    If s1.Cells(i, 4) = Date Then
        x = x + 1
        s2.Cells(x, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(x, 2).Value = s1.Cells(i, 2).Value
        s2.Cells(x, 3).Value = s1.Cells(i, 3).Value
        s2.Cells(x, 4).Value = s1.Cells(i, 4).Value
        s2.Cells(x, 5).Value = s1.Cells(i, 5).Value
    End If
Next i
s2.Range("A:E").Columns.AutoFit
s2.Activate
Set s1 = Nothing: Set s2 = Nothing
s1s = 0: s2s = 0: i = 0: x = 0
End Sub

 

[YUSUF44]

Aşağıdaki kodları dosyanızın ThisWorkbook/BuÇalışmaKitabı kod bölümüne yapıştırıp deneyin:

Private Sub Workbook_Open()
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
For i = 2 To son
    If s1.Cells(i, "D") = Date Then
        If mesaj = "" Then
            mesaj = s1.Cells(i, "B") & " " & s1.Cells(i, "C") & " - " & Format(s1.Cells(i, "D"), "dd.mm.yyyy") & " - " & s1.Cells(i, "E")
        Else
            mesaj = mesaj & Chr(10) & s1.Cells(i, "B") & " " & s1.Cells(i, "C") & " - " & Format(s1.Cells(i, "D"), "dd.mm.yyyy") & " - " & s1.Cells(i, "E")
        End If
    End If
Next
MsgBox mesaj
End Sub

 

[kulomer46]

Merhaba

Alternatif Çalışma : )

D sütununda Tarihi gelen personeli Msgbox ile göster programı

Selamlar...

Ekran Resmi

 

[Astalavista58]

Hepinizden Allah razı olsun ellerinize sağlık çok teşekkür ederim, çok işime yaradı hepsi de