Yılları sıralı olarak yazdırma

tahsinanarat · 11 Ocak 2009

Ekli dosyamda açıklamaya çalıştığım gibi,

01.00 - 2000
01.00 - 03.02 2000 2001 2002
01.00 - 06.04 2000 2001 2002 2003 2004
01.00 - 08.05 2000 2001 2002 2003 2004 2005
01.00 - 10.02 2000 2001 2002
01.00 - 12.01 2000 2001
01.01 - 2001
01.01 - 01.04 2001 2002 2003 2004
01.01 - 05.04 2001 2002 2003 2004
01.01 - 08.03 2001 2002 2003
01.01 - 08.04 2001 2002 2003 2004
01.01 - 09.02 2001 2002
01.01 - 12.02 2001 2002
01.02 - 2002
01.02 - 05.04 2002 2003 2004
01.03 - 2003
01.04 - 2004
01.04 - 09.05 2004 2005
01.05 - 2005
01.06 - 2006
01.07 - 2007
01.50 - 03.62 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962

a sutununda bulunan rakamlar noktadan önceki AY, noktadan sonrakiler YIL'ı göstermektdir, ben bu iki yıl arasındaki tarihleri B sutununda olduğu gibi tek tek yazdırmak istiyorum. Yardımcı olabilecek arkadaşlarıma şimdiden teşekkür ederim.

Necdet · 11 Ocak 2009

Merhaba,

Birşeyler yapmaya çalıştım Tahsin bey, Yanlış yazılımların dışında çalışıyor.

Kod:

Sub Dagit()
Dim i As Long
Dim j, BasYil, BitYil As Integer
On Error Resume Next
Application.ScreenUpdating = False
Range("B1:B65536").ClearContents
For i = 1 To [A65536].End(3).Row
    BasYil = xlNone
    BitYil = xlNone
    a = Split(Cells(i, "A"), " - ")
    For j = 0 To UBound(a)
        b = Split(a(j), ".")
        If j = 0 Then BasYil = b(1) + 0
        If j = 1 Then BitYil = b(1) + 0
    Next j
    BasYil = CInt(BasYil)
    BitYil = CInt(BitYil)
    
    If IsNumeric(BitYil) = False Or BitYil < 0 Then BitYil = BasYil
    If BasYil <= 25 Then
        BasYil = 2000 + BasYil
    Else
        BasYil = 1900 + BasYil
    End If
    
    If BitYil <= 25 Then
        BitYil = 2000 + BitYil
    Else
        BitYil = 1900 + BitYil
    End If
    
    For BasYil = BasYil To BitYil
        Cells(i, "B") = Cells(i, "B") & " " & BasYil
    Next BasYil
    
    Trim (Cells(i, "B"))
    
Next i
Application.ScreenUpdating = True
End Sub

tahsinanarat · 11 Ocak 2009

Sn. Necdet hocam eline sağlık, çok teşekkür ederim. Mükemmel olmuş. Sağolasınız.

tahsinanarat · 11 Ocak 2009

Dosyama uygulayamadım

Sn. Necdet hocam dosyama uyarlayamadım, olması gereken dosyamı ekte gönderiyorum, bakabilirseniz sevinirim. Saygılar

Korhan Ayhan · 11 Ocak 2009

Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Kod:

Option Explicit
 
Sub YIL_LİSTELE()
    Dim X As Long, TERSTEN As String
    Dim TARİH As String, İLK_YIL As String, SON_YIL As String
    Dim TARİHLER As Integer
    
    [B:B].ClearContents
    
    For X = 1 To [A65536].End(3).Row
        TERSTEN = StrReverse(Cells(X, 1))
        TARİH = StrReverse(Mid(TERSTEN, 1, 13))
        İLK_YIL = Mid(TARİH, 4, 2)
        SON_YIL = Mid(TARİH, 12, 2)
    
        If Val(Mid(İLK_YIL, 1, 1)) <> 0 Then
        İLK_YIL = 19 & İLK_YIL
        Else
        İLK_YIL = 20 & İLK_YIL
        End If
        If Val(Mid(SON_YIL, 1, 1)) <> 0 Then
        SON_YIL = 19 & SON_YIL
        Else
        SON_YIL = 20 & SON_YIL
        End If
    
        For TARİHLER = İLK_YIL To SON_YIL
        If Cells(X, 2) = "" Then
        Cells(X, 2) = TARİHLER
        Else
        Cells(X, 2) = Cells(X, 2) & " " & TARİHLER
        End If
        Next
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Necdet · 11 Ocak 2009

Tahsin bey, soruyu sorarken verdiğiniz örnekle şimdi asıl dosyanız aynı değil ki?
Bakınız Korhan bey de üşenmemiş sizi yanıtlamış.

Korhan beyin yanıtını bende düşünmüştüm ama örneginizi görünce bu yöntemden vazgeçmiş ve kendi önerimi getirmiştim.

Şimdi nolcek?

tahsinanarat · 12 Ocak 2009

Necdet hocam haklısınız, ben cümle içinde uygularken farklı olabileceğini düşünmemiştim, Korhan hocam elinize sağlık mükemmel olmuş, her ikinize de çok teşekkür ederim, saygılar. İyi çalışmalar dilerim.

tahsinanarat · 12 Ocak 2009

Gerçek dosyama uyguladığımda olması gerekenler

Sonunda anladımki yardım isterken orjinal dosyanın bir bölümünü göndermek gerektiğini, sn. Korhan hocam, kodlarınız mükemmel çalışıyor, ancak gerçek dosyama uyguladığımda ekli dosyada izah etmeye çalıştım, bazı satırlarda tarih yok, bazılarında ise saadece tek yıl olduğunu belirten "01.96" şeklinde biten satırlar var, tarih olmayanları boş geç geçip, tek yıl belirtilen satırları da saadece "1996" şeklinde yazması gerekiyor.
Sizleri yorduğum için kusuruma bakmayın.

Necdet · 12 Ocak 2009

Merhaba,

Aşağıdaki kodları dener misiniz?

Kod:

Sub Yillar()
On Error Resume Next
[B:B].ClearContents
For i = 1 To [A65536].End(3).Row
    Bul = 0
    Bul = Application.WorksheetFunction.Find("/", Cells(i, "A"))
    Deger = Trim(Right(Cells(i, "A"), Len(Cells(i, "A")) - Bul))
    
    If Deger <> "" Then
        AYil = ""
        BYil = ""
        a = Split(Deger, "-")
        
        For j = 0 To UBound(a)
            b = Split(a(j), ".")
            If j = 0 Then AYil = b(1)
            If j = 1 Then BYil = b(1)
        Next j
        
        If BYil = "" Then BYil = AYil
        
        AYil = Val(AYil)
        BYil = Val(BYil)
        
        If AYil <= 30 Then
            AYil = 2000 + AYil
        Else
            AYil = 1900 + AYil
        End If
        
        If BYil <= 30 Then
            BYil = 2000 + BYil
        Else
            BYil = 1900 + BYil
        End If
            
        Yil = AYil
        
        
        Do While Yil <= BYil
            If Yil = AYil Then
                Cells(i, "B") = Yil
            Else
                Cells(i, "B") = Cells(i, "B") & " " & Yil
            End If
            Yil = Yil + 1
        Loop
        
    End If
    
Next i
End Sub

tahsinanarat · 12 Ocak 2009

Sn. Necdet hocam, sizlere nasıl teşekkür edeceğimi bilemiyorum, 6. mesajınızdan bir daha bu konuya bakmayacaksınız gibi sanmıştım, elinize sağlık, 63.348 satır olan dosyamda hatalı olanları gözle ayıklayıp düzeltmeye çalışıyordum, ancak 15000 satıra kadar gelebilmiştim, beni büyük bir yükten kurtardınız, tekrar çok teşekkür ediyorum. Saoğalısınız,

Necdet · 12 Ocak 2009

aaa Tahsin bey,

Bakmamak olabilir mi? Pazar günü öğleden sonra evde değildim, bir daha giremedim, bugün de işlerden dolayı gecikti yanıt vermem.

Güle güle kullanınız, umarım istediğiniz gibi olmuştur.

tahsinanarat · 12 Ocak 2009

Sn. Necdet bey, çok teşekkürler, olmayan kısımları tekrar gündeme getirmek istemiyorum, gözle kontrolümü yapıp prejeyi tamamlayacağım, şu an 32000 satırdayım, sanıyorum bu gece kontrolü bitiririm. Elinize sağlık. Gerçekten çok mükemmel oldu.

Korhan Ayhan · 12 Ocak 2009

Selamlar,

Bende kendi önerdiğim kodu düzeltmek adına revize edilmiş halini ekliyorum. Verilerinizin tümünün formatını bilemediğimiz için kodun eksiklikleri olabilir. Belirtirseniz düzeltebiliriz.

Kod:

Option Explicit
 
Sub YIL_LİSTELE()
    Dim X As Long, Y As Byte, BUL As Integer, TARİH As String
    Dim İLK_YIL As String, SON_YIL As String
    Dim TARİHLER As Integer
    Dim HARF() As Variant
    
    HARF = Array("A", "B", "C", "Ç", "D", "E", "F", "G", "H", "I", "İ", "J", "K", "L", "M", "N", "O", "Ö", "P", "Q", "R", "S", "T", "U", "Ü", "V", "W", "X", "Y", "Z")
    
    Application.ScreenUpdating = False
    
    [B:B].ClearContents
    
    For X = 1 To [A65536].End(3).Row
        İLK_YIL = ""
        SON_YIL = ""
        If Cells(X, 1) <> Empty Then
        BUL = InStr(1, Cells(X, 1), " /")
        If BUL > 0 Then
            If (Len(Cells(X, 1)) - Len(Replace(Cells(X, 1), "/", ""))) = 1 Then
            TARİH = Trim(Mid(Cells(X, 1), BUL + 2, Len(Cells(X, 1)) - BUL))
            ElseIf (Len(Cells(X, 1)) - Len(Replace(Cells(X, 1), "/", ""))) = 2 Then
            TARİH = Trim(Mid(Cells(X, 1), InStr(InStr(1, Cells(X, 1), "/") + 1, Cells(X, 1), "/") + 1, 15))
            ElseIf (Len(Cells(X, 1)) - Len(Replace(Cells(X, 1), "/", ""))) = 3 Then
            TARİH = Trim(Mid(Cells(X, 1), InStr(InStr(InStr(1, Cells(X, 1), "/") + 1, Cells(X, 1), "/") + 1, Cells(X, 1), "/") + 1, 15))
            End If
                If InStr(1, Trim(TARİH), "-") > 0 Then
                    For Y = 0 To UBound(HARF())
                    TARİH = Replace(Trim(TARİH), HARF(Y), "")
                    Next
                    If InStr(1, Trim(TARİH), ".") > 3 Then
                    İLK_YIL = Mid(Trim(TARİH), InStr(1, Trim(TARİH), ".") + 1, 2)
                    SON_YIL = Mid(Trim(TARİH), InStr(1, Trim(TARİH), "-") + 5, 2)
                    ElseIf Left(Trim(TARİH), 1) = "." Then TARİH = Mid(Trim(TARİH), 2, 15)
                    İLK_YIL = Mid(Trim(TARİH), 4, 2)
                    SON_YIL = Mid(Trim(TARİH), 12, 2)
                    Else
                    İLK_YIL = Mid(Trim(TARİH), 4, 2)
                    SON_YIL = Mid(Trim(TARİH), 12, 2)
                    End If
                Else
                    For Y = 0 To UBound(HARF())
                    TARİH = Replace(Trim(TARİH), HARF(Y), "")
                    Next
                    If Len(Trim(TARİH)) = 5 And InStr(1, Trim(TARİH), ".") > 0 Then
                    İLK_YIL = Mid(Trim(TARİH), 4, 2)
                    SON_YIL = Mid(Trim(TARİH), 4, 2)
                    ElseIf Len(Trim(TARİH)) = 5 And InStr(1, Trim(TARİH), ".") = 0 Then
                    TARİH = Year(CDate(Trim(TARİH)))
                    İLK_YIL = Mid(Trim(TARİH), 3, 2)
                    SON_YIL = Mid(Trim(TARİH), 3, 2)
                    End If
                End If
        ElseIf InStr(1, Trim(Cells(X, 1)), "-") > 0 Then
            İLK_YIL = Val(Mid(Trim(Cells(X, 1)), InStr(1, Trim(Cells(X, 1)), "-") - 3, 2))
            SON_YIL = Val(Mid(Trim(Cells(X, 1)), InStr(1, Trim(Cells(X, 1)), "-") + 5, 2))
        End If
    
        If Len(İLK_YIL) < 2 And Len(SON_YIL) = 2 Then İLK_YIL = SON_YIL
        If Len(İLK_YIL) = 2 And Len(SON_YIL) < 2 Then SON_YIL = İLK_YIL
        If İLK_YIL = "" And SON_YIL <> "" Then İLK_YIL = SON_YIL
        If İLK_YIL <> "" And SON_YIL = "" Then SON_YIL = İLK_YIL
      
        If İLK_YIL <> "" And SON_YIL <> "" And İLK_YIL <> "0" And SON_YIL <> "0" Then
        If Val(Mid(İLK_YIL, 1, 1)) <> 0 Then
            İLK_YIL = 19 & İLK_YIL
            Else
            İLK_YIL = 20 & İLK_YIL
            End If
            If Val(Mid(SON_YIL, 1, 1)) <> 0 Then
            SON_YIL = 19 & SON_YIL
            Else
            SON_YIL = 20 & SON_YIL
            End If
            
        For TARİHLER = İLK_YIL To SON_YIL
            If Cells(X, 2) = "" Then
            Cells(X, 2) = TARİHLER
            Else
            Cells(X, 2) = Cells(X, 2) & " " & TARİHLER
            End If
        Next
        End If
        End If
   Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

tahsinanarat · 13 Ocak 2009

Orjinal dosyadan kalan kısım

Sn. Korhan hocam Uygulamaya çalıştığım orjinal dosyamdan arda kalan kısmı ekte gönderiyorum, 52000 satıra kadar bozuk çıkan kısımları gözle kontrol etmek suretiyle düzelttim, ancak yinede gözden kaçanlar olabiliyor,

Korhan Ayhan · 13 Ocak 2009

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz. Elimden geldiğince tüm olasılıkları denedim. Umarım çok fazla eksik kalmamıştır.

tahsinanarat · 13 Ocak 2009

Sn. Korhan hocam valla çok zahmet verdik, gelir gelmez ilk işim buraya bakmak oldu, yukarıdaki kodlarınızın sonuçlarını inceledim ve şunu fark ettim,
"/" işaretinden sonra gelen örneğin "39084" gibi rakamlar tarihe çevrildiğinde 02.01.2007 tarihini gösteriyor, bazı tarihler kopyala yapıştır yaptığım sırada sayısal değere dönüşmüş, örneğimizde gerçek rakam 02.01 olması gerekiyor.
Kısaca biz sayısal değerleri tarih rakamına çevirdiğimizde örnekde 02.01.2007 ye dönüşen bu tarihin biz ortada bulunan değeri yıl olarak aldırabilirsek gerçek yılımız olan 02.01'in karşılığı olan "2001" değerini vermesi gerekiyor,
Yaklaşık bu şekilde on değişik sayısal değeri tek tek denedim bu şekilde oluyor. Sizin yukarıda yaptığınız kodla bu sayısal değeri "39084" 'ü 1984'e çevirmektedir . oysa olması gereken 2001 dir.
Bunun haricindekilerin lepsi doğru gelmektedir. Saygılarımı sunarım.

Korhan Ayhan · 13 Ocak 2009

Selamlar,

#14 nolu mesajınızdaki örnek dosyanızda bahsettiğiniz satırların numaralarını belirtirseniz fırsatım olduğunda ilgilenmeye çalışırım.

tahsinanarat · 13 Ocak 2009

Hocam; #14 nolu mesajımdaki dosyayı dört örnek satır (kırmızı işaretli olan) yeniledim.

Korhan Ayhan · 13 Ocak 2009

Selamlar,

Ben eklediğiniz dosyada kırmızı işaretli satır göremedim. Sanırım yanlış dosyayı eklediniz.

tahsinanarat · 13 Ocak 2009

Haklısınız yanlış dosyayı eklemişim

Doğru olanı ekte sunuyorum.

Yılları sıralı olarak yazdırma

tahsinanarat

Ekli dosyalar

Necdet

Moderatör

Ekli dosyalar

tahsinanarat

tahsinanarat

Ekli dosyalar

Korhan Ayhan

Administrator

Necdet

Moderatör

tahsinanarat

tahsinanarat

Ekli dosyalar

Necdet

Moderatör

Ekli dosyalar

tahsinanarat

Necdet

Moderatör

tahsinanarat

Korhan Ayhan

Administrator

tahsinanarat

Ekli dosyalar

Korhan Ayhan

Administrator

tahsinanarat

Korhan Ayhan

Administrator

tahsinanarat

Korhan Ayhan

Administrator

tahsinanarat

Ekli dosyalar