Bugün yapılacakların listesi

[gecebekcisi]

Excel de farklı bir sayfada Bugün yapılacaklar otomatik olarak çıkabilir mi? Mesela test-1 ve test-2 16.08.2012 de Yarın ise test-3 ve test 4 yapılacak işlerin çıkması mümkünmü? Yani o tarihin satırındındaki deney isminin çıkmasını istiyorum. Eğer olursa benim işimi acayip kolaylaştıracak. Nasıl yapabilirim?

 

[Korhan Ayhan]

Merhaba,

Bir butona tıkladığınızda bugün yapılacaklar listenizin çıkması işinize yararsa yardımcı olabilirim. Yani makrolu çözüm işinize yarar mı?

 

[gecebekcisi]

Yarar Tabiki

 

[gecebekcisi]

yapılacak işler

Merhaba yaklaşık 300-400 tane tarih olan bir excelimiz var. Ben bunu biraz basite indirerek ekte gönderiyorum. Bugün tarihinde hangi testleri yapmak istediğimizi görmek istiyorum sarı olarak gösterdim. Böyle birşey mümkün mü?

 

[Necdet]

Merhaba,

Kodları deneyiniz.

Sonucu Sayfa2 de listeler.

Sub TarihBul()
    
    Dim Tarih   As Date, _
        s1      As Worksheet, _
        s2      As Worksheet, _
        Adr     As String, _
        c       As Range, _
        i       As Long, _
        j       As Integer
    
    Application.ScreenUpdating = False
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    i = s2.Cells.Find("*", , , , xlByRows, xlPrevious).Row
    If i > 1 Then s2.Range("A2:C" & i).ClearContents
    
    For j = -1 To 1
        Tarih = Date + j
        
        With s1.Cells
            Set c = .Find(Tarih, LookIn:=xlFormulas)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    i = s2.Cells(Rows.Count, j + 2).End(3).Row + 1
                    s2.Cells(i, j + 2) = s1.Range("A" & c.Row)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    Next j
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır....", vbInformation, "N. YEŞERTENER"
    s2.Select
    
End Sub

 

[gecebekcisi]

Çok teşekkürler dediğinizi yaptım. Fakat benim tarihler formül sonucu cıkıyor. Mesela 24.08.2012 tarihi giriyorum. Başka bir hücrede = A2+7 var. ve tarih orada 31.08.2012 gözüküyor. Formüllü tarihleri bu şekilde bulmuyor. Onun için ne yapmalıyım?

 

[Necdet]

Merhaba,

Koddaki

LookIn:=xlFormulas

değerini aşağıdaki şekilde yazıp deneyiniz.

LookIn:=xlValues

 

[gecebekcisi]

LookIn:=xlValues

Yapınca gene çalışmadı boş ekran geliyor

 

[Necdet]

LookIn:=xlValues

Yapınca gene çalışmadı boş ekran geliyor

e o zaman orijinal dosyayı görmek gerek, yada onun bir parçasını.

 

[Tornael]

Yapılacak işin ne kadar zamanını alacağı

Merhaba arkadaşlar,

Yapılacak işin ne kadar zamanımı aldığınıda excelde belirtebilirmiyiz?

Örneğin "Numune" başlıklı sütunda,
"Numune1" işi benim 2 saatimi alıyor, "Numune2" ise 3 saatimi alıyor,
Bana bu işleri hangi tarihte yapmam gerektiğini ve ne kadar zamanımı alıcağını "Sayfa2" deki şablonda belirmesini istiyorum mümkün müdür.

(Örnek excel ekteki gibidir)

Teşekkürler.

 

[Necdet]

Çok teşekkürler dediğinizi yaptım. Fakat benim tarihler formül sonucu cıkıyor. Mesela 24.08.2012 tarihi giriyorum. Başka bir hücrede = A2+7 var. ve tarih orada 31.08.2012 gözüküyor. Formüllü tarihleri bu şekilde bulmuyor. Onun için ne yapmalıyım?

Sizin gönderdiğiniz dosyalarda formül kullandım tarihler için. LookIn:=xlValues ile aramalarda buldu.

 

[gecebekcisi]

orjinal test ekte.. Çok teşekkür ederim.

 

[Necdet]

Merhaba,

Kodları aşağıdaki gibi kullanınız. Tarih olan hücreler biçimlendirdiği için bulamıyordu. Bende biçimlendirilmiş hale çevirdikten sonra arama yaptırdım.

Sub TarihBul()
    
    Dim Tarih   As Date, _
        Tarih1  As String, _
        s1      As Worksheet, _
        s2      As Worksheet, _
        Adr     As String, _
        c       As Range, _
        i       As Long, _
        j       As Integer
    
    Application.ScreenUpdating = False
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    i = s2.Cells.Find("*", , , , xlByRows, xlPrevious).Row
    If i > 1 Then s2.Range("A2:C" & i).ClearContents
    
    For j = -1 To 1
        Tarih = Date + j
        Tarih1 = Format(Tarih, "d mmmm yyyy")
        With s1.Cells
            Set c = .Find(Tarih1, LookIn:=xlValues)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    i = s2.Cells(Rows.Count, j + 2).End(3).Row + 1
                    s2.Cells(i, j + 2) = s1.Range("A" & c.Row)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    Next j
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır....", vbInformation, "N. YEŞERTENER"
    s2.Select
    
End Sub

 

[gecebekcisi]

çok teşşekür ederim süper oldu

 

[Necdet]

çok teşşekür ederim süper oldu

Hep söylerim, örnek dosyanız asıl dosyanızın kopyası olsun diye.

Bakın daha çabuk gittik çözüme

Güle güle kullanınız.

 

[Necdet]

Merhaba arkadaşlar,

Yapılacak işin ne kadar zamanımı aldığınıda excelde belirtebilirmiyiz?

Örneğin "Numune" başlıklı sütunda,
"Numune1" işi benim 2 saatimi alıyor, "Numune2" ise 3 saatimi alıyor,
Bana bu işleri hangi tarihte yapmam gerektiğini ve ne kadar zamanımı alıcağını "Sayfa2" deki şablonda belirmesini istiyorum mümkün müdür.

(Örnek excel ekteki gibidir)

Teşekkürler.

Merhaba,

Sorunuzu tam olarak anladım mı bilemiyorum. Kodları deneyiniz.

Sub AraBul()
    
    Dim i       As Long, _
        Sat     As Long, _
        j       As Integer, _
        k       As Integer, _
        Kol     As Integer, _
        iKol    As Integer, _
        Tarih   As Date, _
        c       As Range, _
        Adr     As String, _
        s1      As Worksheet, _
        s2      As Worksheet
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    s1.Select
    Sat = s2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    s2.Range("A2:F" & Sat).ClearContents    'Sayfa2 nin başlık hariç bilgileri silindi
    
    Kol = Cells(1, Columns.Count).End(1).Column - 1
    iKol = -1
    For k = -1 To 1                             'Dünden yarına döngü kuruldu
        iKol = iKol + 2
        Tarih = Date + k                        'Dün-Bugün-Yarınki Tarih Değeri Bulunuyor
        For j = 2 To Kol Step 2                 'Aranacak Kolonların Bulunması
            i = Cells(Rows.Count, j).End(3).Row 'aranan kolonon son satırı
            Set c = Nothing
            Adr = ""
            
            With Range(Cells(2, j), Cells(i, j))    'Kolonlarda Arama Yapılıyor
                Set c = .Find(Tarih, LookIn:=xlValues)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        Sat = s2.Cells(Rows.Count, iKol).End(3).Row + 1
                        s2.Cells(Sat, iKol) = Cells(c.Row, 1)
                        s2.Cells(Sat, iKol + 1) = c.Offset(0, 1).Value
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End With
            
        Next j
    Next k
    MsgBox "İşlem tamamlanmıştır....", vbInformation, "N. YEŞERTENER"
    s2.Select
    
End Sub

 

[Tornael]

Teşekkür

Merhaba,

Sorunuzu tam olarak anladım mı bilemiyorum. Kodları deneyiniz.

Sub AraBul()
    
    Dim i       As Long, _
        Sat     As Long, _
        j       As Integer, _
        k       As Integer, _
        Kol     As Integer, _
        iKol    As Integer, _
        Tarih   As Date, _
        c       As Range, _
        Adr     As String, _
        s1      As Worksheet, _
        s2      As Worksheet
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    s1.Select
    Sat = s2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    s2.Range("A2:F" & Sat).ClearContents    'Sayfa2 nin başlık hariç bilgileri silindi
    
    Kol = Cells(1, Columns.Count).End(1).Column - 1
    iKol = -1
    For k = -1 To 1                             'Dünden yarına döngü kuruldu
        iKol = iKol + 2
        Tarih = Date + k                        'Dün-Bugün-Yarınki Tarih Değeri Bulunuyor
        For j = 2 To Kol Step 2                 'Aranacak Kolonların Bulunması
            i = Cells(Rows.Count, j).End(3).Row 'aranan kolonon son satırı
            Set c = Nothing
            Adr = ""
            
            With Range(Cells(2, j), Cells(i, j))    'Kolonlarda Arama Yapılıyor
                Set c = .Find(Tarih, LookIn:=xlValues)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        Sat = s2.Cells(Rows.Count, iKol).End(3).Row + 1
                        s2.Cells(Sat, iKol) = Cells(c.Row, 1)
                        s2.Cells(Sat, iKol + 1) = c.Offset(0, 1).Value
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End With
            
        Next j
    Next k
    MsgBox "İşlem tamamlanmıştır....", vbInformation, "N. YEŞERTENER"
    s2.Select
    
End Sub

Ellerine sağlık, çok güzel olmuş, teşekkür ediyorum,