• DİKKAT

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

Belli tarihe göre görev listesi

Katılım
18 Temmuz 2009
Mesajlar
56
Excel Vers. ve Dili
2007
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

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
 
Merhaba,
siz dosyanıza belli bir tarih için yapılmış örnek ekleyebilirseniz
ilgilenecek arkadaşlara yol göstermiş olursunuz, saygılar.
 
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

Çok teşekkür ederim. Beni büyük bir yükten kurtardın. Büyüksün usta..
 
Ç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:
 
Geri
Üst