macro hata veriyor ve tarih süzmesini yapamadım.

drseref · 22 Nisan 2011

bu siteden çok yararlandım.göndermiş olduğum dosyada data sayfasında satır sayısı artıkça sayfa kitleniyor.
ayrıca raporlama sayfasında tarih süzmesini yapamadım.
yardımlarınız için şimdiden tşk....

drseref · 23 Nisan 2011

yardımcı olursanız sayın hocalarım..

drseref · 23 Nisan 2011

önemli bir dosya bebek aşı ve izlem takibi.
cevap hocalarım.....

drseref · 23 Nisan 2011

mali tabloları ne güzel de hemen cevaplıyorsunuz.
bayram kutlaması da ne güzel yaptınız.
2 gündür sizden cevap bekliyorum.
hemde 23 nisan konu bebek aşı ve izlem takibi..
tabi konu pek ilgilendirmiyor herhalde uzmanlar.
bu çocuklar için ve evrensel ortamda bir tabloya bile yardımcı olamadınız...
sağolun.
mesainizi biraz da bunun için harcasanız...
bu gün ne yaptım diye sorduğunuz da bayram için.
mali tablo mu düzenledim diyeceksiniz uzmanlarım.....

Necdet · 23 Nisan 2011

Merhaba,

Sayın drseref,

Sorunuz çok açıklayıcı değil, yanıt alamamanızın nedeni bu olabilir.

Bende dosya yapınızı biraz eleştireyim.

Data sayfasında başlık 3. satırdan başlıyor ve sütun aralarında boşluklar koymuşsunuz.

Bu şekilde tasarlarsanız kod yazmada hatta fonksiyonlarda ek sıkıntı getirir.

İlla her işlem ayrı görünsün diye yaptıysanız bunu değişik renkli kalınlıkta çizgi ile belirleyebilirsiniz.

Raporlama sayfası da keza aynı yapıda.

Bu küçük eleştiriden sonra :

Data sayfasında çalışan bir kodunuz vardı ki bu çok yanlış düşünülüp yazılmış bir kod idi.

Çünkü Worksheet_Change olayına değil Selection Change olayına bağlanmıştı. Bunun anlamı herhangi bir hücreye tıkladığınızda yada seçtiğinizde tüm hesaplamalar yeniden yeniden ve yeniden yapılacaktı.

Dosyanızın yavaşlama nedeni bu. Ben bu kodları Worksheet_Change
olayına bağladım.

C sütununa tarih girdiğiniz an diğer tarihler hesaplanacak ya da o tarihi sildiğinizde ise diğer tarihler silinecek.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
If Target.Row < 5 Then Exit Sub
If Target.Value = "" Then
    Range("E" & Target.Row & ":X" & Target.Row).ClearContents
Else
    Cells(Target.Row, "E") = Target.Value
    Cells(Target.Row, "F") = Target.Value + 29
 
    Cells(Target.Row, "H") = Target.Value + 30
    Cells(Target.Row, "I") = Target.Value + 59
 
    Cells(Target.Row, "K") = Target.Value + 60
    Cells(Target.Row, "L") = Target.Value + 89
 
    Cells(Target.Row, "N") = Target.Value + 90
    Cells(Target.Row, "O") = Target.Value + 119
 
    Cells(Target.Row, "Q") = Target.Value + 120
    Cells(Target.Row, "R") = Target.Value + 149
 
    Cells(Target.Row, "T") = Target.Value + 180
    Cells(Target.Row, "U") = Target.Value + 209
 
    Cells(Target.Row, "W") = Target.Value + 270
    Cells(Target.Row, "X") = Target.Value + 299
End If
End Sub

Raporlama sayfasında ise ben şunu anladım :

herhangi bir türih girdiğinde tüm izlem tarihleri kontrol edilecek ve o tarih içinde olanlar listelenecek.

Doğru mu?

Aşağıdaki kod Raporlama sayfasının kod bölümünde olmalı

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, [F1]) Is Nothing Then Exit Sub
    
    RaporAl
    
End Sub

Aşağıdaki kodları da bir modüle kopyalayınız.

Kod:

Sub RaporAl()
    Dim Aranan  As String, _
        i       As Long, _
        SonSat  As Long, _
        Sat     As Long, _
        Kol     As Integer, _
        Bayrak  As Boolean, _
        Data    As Worksheet, _
        Rapor   As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Data = Sheets("data")
    Set Rapor = Sheets("raporlama")
    Rapor.Select
    
    Aranan = Format(Range("F1"), "yyyymm")
    i = Cells(Rows.Count, "C").End(3).Row
    If i < 4 Then i = 4
    Range("C4:G" & i).ClearContents     'Sayfadaki eski bilgiler silindi
    
    SonSat = Data.Cells(Rows.Count, "A").End(3).Row 'data sayfasının son satırı bulundu
    If SonSat < 5 Then SonSat = 5
    
    Sat = 3
    For i = 5 To SonSat
    
        Kol = 5
        Bayrak = False
        
        Do
            If Format(Data.Cells(i, Kol), "yyyymm") = Aranan Then
                Bayrak = True
            Else
                Kol = Kol + 3
            End If
        Loop While Kol < 24 And Bayrak = False
        
        If Bayrak = True Then
            Sat = Sat + 1
            Cells(Sat, "C") = Data.Cells(i, "A")
            Cells(Sat, "D") = Data.Cells(i, "B")
            Cells(Sat, "E") = Data.Cells(i, Kol)
            Cells(Sat, "F") = Data.Cells(i, Kol).Offset(0, 1)
            If Date < Data.Cells(i, Kol).Offset(0, 1) Then
                Cells(Sat, "G") = Data.Cells(i, Kol).Offset(0, 1) - Date
            Else
                Cells(Sat, "G") = "Zaman Geçti"
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
    If Sat > 3 Then MsgBox Sat - 3 & " Adet Çocuk Listelenmiştir.....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

drseref · 23 Nisan 2011

necdet abi beni çok tşk ederim öncelikle.sorumu anlamışsınız.YENİ DOSYAYI YÜKLEDİM ve Necdet abi data sayfasında macro 4 satırdan sonra çalışmıyor.ayrıca raporlama sayfasında yeni bir sütun ekledim onuda sayfada nasıl gösterebiliriz.

Necdet · 23 Nisan 2011

Merhaba,

Dosyada satır sınırlaması yapmadım, Eğer gerçek dosyanızda örnek dosya yapısında ise çalışması gerekir.

Yoksa gerçek dosyanızın bir kaç satırını silip gönderin bakalım.

drseref · 23 Nisan 2011

If Target.Value = "" Then
hatalı satır olarak bunu gösterdi.

Necdet · 23 Nisan 2011

Merhaba,

Dosyayı görmem gerek, hata olabilecek bir kod değil ki o?

C sütununda doğum tarihi yazdığınız an hesaplamaları yapacak, ola ki yanlış yazdınız silebilirsiniz de o kontrol onun için kondu.

drseref · 23 Nisan 2011

tamam hocam elle yazıcan oldu.
kopyala yapıştı yapınca doğum tarihini hata verdi.
hocam raporlama sayfasındaki soruma bir cevap alabilirmiyim.

Necdet · 23 Nisan 2011

drseref' Alıntı:
hocam raporlama sayfasındaki soruma bir cevap alabilirmiyim.

Ben mi soruyu kaçırdım yoksa başka bir neden mi var?

Raporlama sayfasındaki sorun neydi?

drseref · 23 Nisan 2011

abi sorum raporlama sayfasında bebeğin kaçıncı izlemi olduğunu sütunda göstermesi .ben sana kendi orjinal dosyamı DOĞUM TARİHLERİYLE gönderiyorum...

Necdet · 23 Nisan 2011

Merhaba,

Bu dosyayı kendiniz tek tek değil de başka bir ortamdan mı kopyalıyorsunuz?

drseref · 23 Nisan 2011

Evet.
Kullandığımız sql veri tabanı olan ahbs programından excele aktar diyorum.
Adı-soyadı-doğum tarihi şeklinde geliyor.

drseref · 23 Nisan 2011

Abi nasıl gelişme var mı ?

Necdet · 23 Nisan 2011

Merhaba,

Tarihlerle ilgili sorun yaşıyorum, üzerinde çalışıyorum.

Necdet · 24 Nisan 2011

Tekrar Merhaba,

Data sayfasındaki kodları Modüle aktardım ve sildim.

Butona bağladım.

Kod:

Sub Izlenim_Tarihleri_Hesapla()
    Dim i   As Long
    
    Sheets("data").Select
    
    Application.ScreenUpdating = False
    
    For i = 4 To Cells(Rows.Count, "C").End(3).Row
    
        Cells(i, "C") = DateAdd("d", 0, Cells(i, "C"))
        Cells(i, "E") = Cells(i, "C") + 0
        Cells(i, "F") = Cells(i, "C") + 29
        
        Cells(i, "H") = Cells(i, "C") + 30
        Cells(i, "I") = Cells(i, "C") + 59
        
        Cells(i, "K") = Cells(i, "C") + 60
        Cells(i, "L") = Cells(i, "C") + 89
        
        Cells(i, "N") = Cells(i, "C") + 90
        Cells(i, "O") = Cells(i, "C") + 119
        
        Cells(i, "Q") = Cells(i, "C") + 120
        Cells(i, "R") = Cells(i, "C") + 149
        
        Cells(i, "T") = Cells(i, "C") + 180
        Cells(i, "U") = Cells(i, "C") + 209
        
        Cells(i, "W") = Cells(i, "C") + 270
        Cells(i, "X") = Cells(i, "C") + 299
    Next i
    
End Sub

Listelemede İzlinim numarası istenmiş kodlar :

Kod:

Sub RaporAl()
    Dim Aranan  As String, _
        i       As Long, _
        SonSat  As Long, _
        Sat     As Long, _
        Kol     As Integer, _
        Bayrak  As Boolean, _
        Data    As Worksheet, _
        Rapor   As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Data = Sheets("data")
    Set Rapor = Sheets("raporlama")
    Rapor.Select
    
    Aranan = Format(Range("F1"), "yyyymm")

    i = Cells(Rows.Count, "C").End(3).Row
    If i < 4 Then i = 4
    Range("C4:G" & i).ClearContents     'Sayfadaki eski bilgiler silindi
    
    SonSat = Data.Cells(Rows.Count, "C").End(3).Row 'data sayfasının son satırı bulundu
    If SonSat < 4 Then SonSat = 4
    
    Sat = 3
    For i = 5 To SonSat
    
        Kol = 5
        Bayrak = False
        
        Do
            If Format(Data.Cells(i, Kol), "yyyymm") = Aranan Then
                Bayrak = True
            Else
                Kol = Kol + 3
            End If
        Loop While Kol < 24 And Bayrak = False
        
        If Bayrak = True Then
            Sat = Sat + 1
            Cells(Sat, "C") = Data.Cells(i, "A")
            Cells(Sat, "D") = Data.Cells(i, "B")
            Cells(Sat, "E") = Data.Cells(i, Kol)
            Cells(Sat, "F") = Data.Cells(i, Kol).Offset(0, 1)
            If Date < Data.Cells(i, Kol).Offset(0, 1) Then
                Cells(Sat, "G") = Data.Cells(i, Kol).Offset(0, 1) - Date
            Else
                Cells(Sat, "G") = "Zaman Geçti"
            End If
            [B][COLOR=red]Cells(Sat, "H") = Data.Cells(1, Kol)
[/COLOR][/B]        End If
    Next i
    
    Application.ScreenUpdating = True
    If Sat > 3 Then MsgBox Sat - 3 & " Adet Çocuk Listelenmiştir.....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

Korhan Ayhan · 24 Nisan 2011

Selamlar,

Bende bir örnek dosya hazırlamıştım. Alternatif olarak incelermisiniz.

macro hata veriyor ve tarih süzmesini yapamadım.

drseref

Ekli dosyalar

drseref

drseref

drseref

Necdet

Moderatör

Ekli dosyalar

drseref

Necdet

Moderatör

drseref

Necdet

Moderatör

drseref

Necdet

Moderatör

drseref

Ekli dosyalar

Necdet

Moderatör

drseref

drseref

Necdet

Moderatör

Necdet

Moderatör

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar