• DİKKAT

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

Bugün yapılacakların listesi

Katılım
17 Şubat 2012
Mesajlar
18
Excel Vers. ve Dili
excel 2011 for mac
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?
 

Ekli dosyalar

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ı?
 
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ü?
 

Ekli dosyalar

Merhaba,

Kodları deneyiniz.

Sonucu Sayfa2 de listeler.

Kod:
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
 

Ekli dosyalar

Ç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?
 
Merhaba,

Koddaki

LookIn:=xlFormulas

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

LookIn:=xlValues
 
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.
 

Ekli dosyalar

Ç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.
 
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.

Kod:
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
 
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.

Kod:
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
 

Ekli dosyalar

Teşekkür

Merhaba,

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

Kod:
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,
 
Geri
Üst