AccessTr.neT

İlk öncelik ile konuyu okuyan ve destek olan olmayan tüm arkadaşlara teşekkür ederim.
Excelde her ay yapmak istediğim şey personelin 0,5 saatlik mesaisini onaylatmam gerekiyor bunun içinde her ay tek tek personelin çalıştığı tarihleri saatleri ve bayramları belirtecek şekilde tek tek sayfa haline getirip çıktı alıp onaylatıyorum. Bunu yaparken makro veya daha farklı bir yöntem ile yapabilmem mümkün mü. Sadece çalıştığı günleri mesela Raporlu olduğu senelik izin sosyal izin veya F (08:00-18:00) çalıştığı günleri listelemesini istemiyorum. Diğer günleri saatleri ve tarihleri sicil no statüsü bunların otomatik bir şekilde olmasını nasıl sağlarım.

Aşağıdaki kodu boş bir modüle ekledikten sonra buton yardımı ile kullanıyorum.
Vardiya Listesi sayfasında Personel adına tıkladıktan sonra makroyu çalıştırırsanız listeyi o personelin bilgilerine göre güncelleyecektir.
Benim istediğim ise tüm personelleri tesis isimleri ile yeni Excel oluşturup ikinci sayfadaki formatta kaydetmesi. Aylık olarak verileri saklamam gerekiyor mesela Ekim Kavaklıdere , Ekim Çambel Pompa İstasyonu, Ekim Karaçam diğer ay ise Kasım Kavaklıdere gibi yeni Excel açıp tüm personelleri oluşturması.

Kod:
Sub Deneme()

If ActiveCell.Column <> 3 Or ActiveCell.Value = "" Or ActiveCell.Value = "ADI VE SOYADI" Then Exit Sub

Application.ScreenUpdating = False

Dim i, dd, secim, y, ayy, yill As Integer

Dim mekan As String

Sayfa2.Range("A6:M36").ClearContents

ayy = Val(InputBox("Ay Seçin", "", Month(Date)))

yill = Val(InputBox("Yıl Girin", "", Year(Date)))

If ayy > 12 Or ayy < 0 Then Exit Sub

dd = 6

secim = ActiveCell.Row

If secim < 18 Then

mekan = "Kavaklıdere İçme Suyu Arıtma Tesisinin "

    Else

    If secim < 26 Then

        mekan = "Çambel Pompa İstasyonunun "

        Else

            mekan = "Karaçam İçme Suyu Arıtma Tesisinin"

    End If

End If

For i = 4 To 34

If Sayfa1.Cells(secim, i) = "C" Or Sayfa1.Cells(secim, i) = "D" Or Sayfa1.Cells(secim, i) = "E" Then

Sayfa2.Cells(dd, 1) = Sayfa1.Cells(secim, 2)

Sayfa2.Cells(dd, 2) = Sayfa1.Cells(secim, 1)

Sayfa2.Cells(dd, 3) = Sayfa1.Cells(secim, 3)

Sayfa2.Cells(dd, 4) = "Teknisyen"

Sayfa2.Cells(dd, 5).Formula = "=DATE(" & yill & "," & ayy & "," & i - 3 & ")"

Sayfa2.Cells(dd, 6) = Format(WorksheetFunction.VLookup(Sayfa1.Cells(secim, i), Sayfa1.Range("AJ:AM"), 3, 0), "HH:MM") & " - " & Format(WorksheetFunction.VLookup(Sayfa1.Cells(secim, i), Sayfa1.Range("AJ:AM"), 4, 0), "HH:MM")

Sayfa2.Cells(dd, 7) = "Fazla Mesai"

Sayfa2.Cells(dd, 8) = ""

Sayfa2.Cells(dd, 9) = "0,5 saat"

Sayfa2.Cells(dd, 10) = mekan & " kesintisiz işletilmesinde vardiya personeli olarak görev yapmaktadır."

dd = dd + 1

End If

Next i

Sayfa2.Select

    Cells.Select

    Selection.EntireRow.Hidden = False

For y = 6 To 36

If Sayfa2.Cells(y, 3) = "" Then

Sayfa2.Rows(y).Select

Selection.EntireRow.Hidden = True

End If

Next y

Application.ScreenUpdating = True

End Sub

Harici link kaldırılmıştır. Örneğinizi mesajınızı önizleme yaparak dosya ekle kısmından ekleyiniz.

Mesajınızı yazdıktan sonra önzile yapın ve gelen ekranda sol altta yer alan dosya ekle bölümünden ekleyin. Kaynağı ve/evya güvenilirliği belirsiz dış linkler ile örnek paylaşmayınız.

(13/10/2023, 10:48)atoykan yazdı: [ -> ]Mesajınızı yazdıktan sonra önzile yapın ve gelen ekranda sol altta yer alan dosya ekle bölümünden ekleyin. Kaynağı ve/evya güvenilirliği belirsiz dış linkler ile örnek paylaşmayınız.

Kusura bakmayın düzeltim..

Sizin çalışmanızda sorunlu, kodlarınızın rangeleri hatalı bu kodlarla sayfayı nasıl dolduruyorsunuz. Bakayım diyorum 1 aydır masaüstümde kayıtlı bölük pörçük toparlamaya çalışırken içeriğinizin amacını dahi unutuyorum zaman zaman.

merttr07

atoykan

merttr07

atoykan