Belli tarihe göre görev listesi

Katılım
18 Temmuz 2009
Mesajlar
56
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
16.03.2019
Merhaba
Beni bir kaç gündür uğraştıran derdime çare olmanız için mesajı yazdım. Belli bir görev listesi var, bu görev listesine göre tarih yazıldığında o tarihte görevli olan personeli sıralayıp gösterecek bir makro arıyorum.
 

Ekli dosyalar

İ

İhsan Tank

Misafir
Merhaba
Beni bir kaç gündür uğraştıran derdime çare olmanız için mesajı yazdım. Belli bir görev listesi var, bu görev listesine göre tarih yazıldığında o tarihte görevli olan personeli sıralayıp gösterecek bir makro arıyorum.
merhaba
öğretmenlerin listesi nerede
tarihler nerede bunların bilgilerini veriseniz formül ile çözebilirim
 

Mehmet Şahin

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
Merhaba,
siz dosyanıza belli bir tarih için yapılmış örnek ekleyebilirseniz
ilgilenecek arkadaşlara yol göstermiş olursunuz, saygılar.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod:
Option Base 1
Sub gorevli_ogretmenler_59()
Dim myarr1(), myarr(2), a As Long, k As Byte, sat As Long
Dim sh As Worksheet, i As Long
Sheets("GÖREV").Select
Range("A5:E65536").Clear
If Not IsDate(Range("D3").Value) Then
    MsgBox "D3 hücresine tarih girilmemeiş." & vbLf & _
    "İşlem iptal edildi" & "evrengizlen@hotmail.com", vbCritical, "UYARI"
    Range("D3").Select
    Exit Sub
End If
Set sh = Sheets("PROGRAM")
sat = sh.Cells(65536, "B").End(xlUp).Row
If sat < 3 Then Exit Sub
myarr1 = sh.Range("B3:N" & sat)
ReDim myarr2(1 To 2, 1 To sat * 9)
For i = 1 To UBound(myarr1, 1)
    If CDate(myarr1(i, 1)) = CDate(Range("D3").Value) Then
        For k = 6 To 13
            If myarr1(i, k) <> "" Then
                a = a + 1
                myarr2(1, a) = a
                myarr2(2, a) = myarr1(i, k)
            End If
        Next k
    End If
Next i
If a > 1 Then
    ReDim Preserve myarr2(2, a)
    Range("A5").Resize(a, 2) = Application.Transpose(myarr2)
    MsgBox "İşlem Tamamlandı." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
    Erase myarr1: Erase myarr2
End If

End Sub
 

Ekli dosyalar

Katılım
18 Temmuz 2009
Mesajlar
56
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
16.03.2019
Çok teşekkür ederim. Beni büyük bir yükten kurtardın. Büyüksün usta..
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Çok teşekkür ederim. Beni büyük bir yükten kurtardın. Büyüksün usta..
Rica ederim.
Bunun içinde müdürlerde vardır .Bilginize.:cool:
 
Üst