döngü olması gerektiği gibi neden başa dönmedi?

[aybekcan]

merhaba
eklediğim excel sayfasında 1. sayfada düzensiz tarihler var.Ben bunu ikinci sayfada,yine o sayfada bir kısmını yaptığım gibi istiflemek istiyorum.fakat yazdığım macro ilk iki ayı sorunsuz yapmasına rağmen daha sonraki aylara geçmedi.ocak ayı 31 olduğu için onu direkt yaptı,sonra yine şarta bağlı koşulları şubat ayına denedi, şubat 28 çektiği için 3. şartlı bölüme geçti ve şubatı düzenli şekilde doldurdu,daha sonra gelen mart ayı 31 olduğu için ona hiç girmeden end sub kısmına geldi ve proğramı bitirdi.
Benim yapmaya çalıştığıma göre ise yine martı değerlendirmesi ve onuda 31 çeken aylara göre yapması gerekiyordu ve devam ederek bütün ayları bitirmesi gerekiyordu.Bu makroyu nasıl düzeltirim lütfen yardımlarınızı bekliyorum.dosya http://s3.dosya.tc/server15/0r6y7f/tarih.rar.html

 

[alicimri]

Dosyanızı yedekleyin. Sayfa1 de işlem yapıp değiştiriyor. Tabloyu Sayfa3 de oluşturuyor.

Sub aktar()
For i = Range("a65536").End(3).Row To 1 Step -1
If Mid(Range("A" & i), 1, 1) <> "|" Then
Rows(i).Delete Shift:=xlUp
End If
Next
 Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True
        süt = 1
sat = 1
ay = 1
  With Columns("A:H")
    Set c = .Find("SR*", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
          ilk = Range(c.Address).Offset(-1, 0).Address
                    son = Range(c.Address).Offset(3, 0).Address
   If Range(ilk) = 1 Then
        sat = Sheets("Sayfa3").Range("a65536").End(3).Row + 2
        Sheets("Sayfa3").Range("a" & sat - 1).Value = ay
          Sheets("Sayfa3").Range("b" & sat - 1).Value = Format(DateAdd("m", ay, 1), "mmmm")
        süt = 1
                    ay = ay + 1

        End If
           Range(ilk & ":" & son).Copy Sheets("Sayfa3").Cells(sat, süt)
            Set c = .FindNext(c)
            süt = süt + 1
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub

 

[aybekcan]

hocam çok teşekkür ederim.2018 yılını yapıyor fakat farlı yılları denediğimde takılıyor ve "400" hatası veriyor.ayrıca bu macrodan sonra nedenini anlamadım ama daha önce ham veriyi excel e kopyaladığımda bütün haftanın verilerini tek hücre içine atıyordu,şimdi ise tek tek hücrelere atıyor ki bu çok iyi oldu.her ne yaptıysanız elinize sağlık.

 

[alicimri]

Dosya yapıları aynı ise sorun çıkmaması gerekiyor. ham veriyi aldığınız dosyanın formatı nedir.

 

[aybekcan]

dosya formatını bilemiyorum hocam,bu astronomi lab diye bir proğram ve aylarının günlük ay doğuş batışı gibi bilgilerini veriyor.fakat sayfayı kendi oluşturuyor ve herhangi bir yere kaydetmeye izin vermiyor.sadece "kopyala" özelliği var ,oda belgelere göre düzensiz kaydediyor.

 

[alicimri]

Yukardaki kodlar Excel dosyasının örnekteki haline göre çalışıyor. Eğer kopyalayıp excel dosyasına veri aktardığınızda, ilk örneğe uygun format oluşmuyorsa hataya düşer. kopyaladığınız verileri txt dosyasına yapıştırırsanız. Hep aynı formatta olacağından, kodlarda yapılacak bir değişiklikle sorunsuz çalışır.
Not: Başka bir yerden kopyalayıp yapıştırdığınız veriler arasında örneğin "*" karakteri varsa ,ilkinde bu verileri tek hücreye yapıştırır. "Metni Sütunlara dönüştür" işlemi ile bu verileri bir kere yandaki hücrelere dağıtırsanız. O sayfayı silseniz dahi aynı verileri başka sayfaya yapıştırırsanız aralarında "*" karakteri olan verileri ayrı hücrelere (sütunlara) alır. Ancak yeni bir excel dosyası açıp ona yapıştırırsanız, tek hücreye yapıştırır. Benim kodlarım arasında bu "Metni Sütunlara Dönüştür" işlemi yapılıyor.

 

[aybekcan]

çok teşekkür ederim hocam...