Başka sayfaya Rapor

[akhsahbaz]

Arkadaşlar;
Bana bir makro lazım.Ben bu işlemi formül ile yaptırdım.Fakat işlemi üzerine uyguladığım form ile açtırmam 30 dk ları buluyor.Hemen anlatmaya başlıyorum.
Elimizde "Form" ve "Rapor" adlı iki sayfa var. "Form" sayfasının "J" sütunundaki sayı değeri olabilirde olmaya bilirde.(Bunu söylememin sebebi raporlamada boşlukarı vermeyecek) Eğer sayı değeri varsa önce "Form" sayfasındaki o satırın "A:J" arasındaki hücreleri aynen "Rapor" sayfasına kopyalayacak.Sonrada "K" sütunundan başlayarak "J" değeri kadar "A" sütununa (bu sütun tarih içeriyor) ekliyerek devam edecek.
Örneğin "Form!J1"in değeri 3, "Form!A1"de 1 Ocak 2000 olsun. "Rapor!K" 1 Şubat 2000, "Rapor!L" de 1 Mart 2000 olacak.
Yardımlarınız ve vakit ayırdığınız için şimdiden çok teşekkür ederim.

 

[Recep İpek]

Sonuçlarıda gösterilmiş küçük bir örnek dosya ekleyebilirmisiniz?

 

[akhsahbaz]

Yardımınız ve zaman ayırdığınız için çok teşekkür ederim.

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub Aktar()
Set s1 = Sheets("Form")
Set s2 = Sheets("Rapor")
s2.Range("a2:as1000").ClearContents
For i = 3 To s1.[j65536].End(3).Row
    If s1.Cells(i, "j").Value > 1 Then
        sat = s2.[a65536].End(3).Row + 1
        Range(s2.Cells(sat, "a"), s2.Cells(sat, "I")).Value = Range(s1.Cells(i, "b"), s1.Cells(i, "j")).Value
        s2.Cells(sat, "j").Value = s1.Cells(i, "a").Value
        For j = 1 To s1.Cells(i, "j").Value - 1
            tar = s2.Cells(sat, 9 + j).Value
            s2.Cells(sat, 10 + j).Value = CDate(Day(tar) & "/" & Month(tar) + 1 & "/" & Year(tar))
        Next j
    End If
Next i
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[akhsahbaz]

Sayın hocam,
program üzerinde taksit sayısı değerlerinde oynama yaptığımızda program hata veriyor.

 

[Recep İpek]

Ne yaptığınızda nasıl bir hata veriyor?

 

[akhsahbaz]

gönderdiğiniz örnekte taksit sayılarında değişiklikler yapın. Örneğin ilk taksit sutununa 36 deyin.raporlama yaptığınızda hata veriyor

 

[Recep İpek]

Koldarı aşağıdaki şekilde değiştiriniz.

Sub Aktar()
Set s1 = Sheets("Form")  
Set s2 = Sheets("Rapor")
s2.Range("a2:as1000").ClearContents
For i = 3 To s1.[j65536].End(3).Row [COLOR=blue]'Form sayfasının 3.satırından j kolonunun son dolu[/COLOR] hücresine kadar
    If s1.Cells(i, "j").Value > 1 Then  [COLOR=blue]'eğer hücre 1'den büyük ise [/COLOR]
        sat = s2.[a65536].End(3).Row + 1 [COLOR=blue]'Rapor sayfasındaki son dolu hücresinin 1 fazlasına[/COLOR]
        Range(s2.Cells(sat, "a"), s2.Cells(sat, "I")).Value = Range(s1.Cells(i, "b"), s1.Cells(i, "j")).Value  '[COLOR=blue] Bu satırı kopyala[/COLOR]
        s2.Cells(sat, "j").Value = s1.Cells(i, "a").Value ' [COLOR=blue]Form sayfasının j kolonuna Rapor sayfasının a kolonunu kopyalaya[/COLOR]
        For j = 1 To s1.Cells(i, "j").Value - 1 ' [COLOR=blue]1'den taksit sayısının 1 eksiğine kadar.[/COLOR]
            tar = s2.Cells(sat, 9 + j).Value [COLOR=blue]' ilgili tarih tar değişgenine aktarılıyor[/COLOR]
            If Month(tar) + 1 < 13 Then [COLOR=blue]'&#304;lgili tarihin ay&#305; 12'den k&#252;&#231;&#252;k ise[/COLOR]
            ytar = CDate(Day(tar) & "/" & Month(tar) + 1 & "/" & Year(tar)) ' [COLOR=blue]Tarihe 1 ay ekle[/COLOR]
            Else
            ytar = CDate(Day(tar) & "/" & 1 & "/" & Year(tar) + 1) [COLOR=blue]'De&#287;il ise tarihi Ocak ve 1 y&#305;l sonras&#305;n&#305; yap[/COLOR]
            End If
            s2.Cells(sat, 10 + j).Value = ytar ' [COLOR=blue]sa&#287;a do&#287;ru ilgili kolona yeni tarihi yaz.[/COLOR]
        Next j
    End If
Next i
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[akhsahbaz]

Sayın Ripek,
Allah razı olsun. Makrodan anlamadığım için günlerdir uğraşıyordum. Belki komik gelecek ama artık kodları rüyalarımda bile görmeye başlamıştım. Sayenizde programımı tamamladım. Ellerinize sağlık. Tekrar tekrar teşekkür ederim.

 

[Recep İpek]

...Belki komik gelecek ama artık kodları rüyalarımda bile görmeye başlamıştım...

İlk önceleri benimde rüyalarıma giriyordu ama, şimdi alıştım...

 

[akhsahbaz]

Sayın hocam,
Eğer mahsuru yoksa formüllerin açıklamasını eklermisiniz. Böylece benim gibi kodlamayı öğrenmeye çalışan arkaşlara yardımcı olmuş oluruz.

 

[Recep İpek]

Dilimiz döndüğü kadarıyla ilgili açıklamaları yazmaya çalıştım.

 

[akhsahbaz]

Teşekkürler. Elinize sağlık.

 

[akhsahbaz]

Kendi çalışmamı ekliyorum. Acaba "Ayarlar" bölümü etkilermi.

 

[Recep İpek]

Makronun çalışması için B kolonundaki Hesap Sahibi bilgilerinin dolu olması gerekmektedir.

Yalnız burada şu şekil bir problem ortaya çıktı.

İşlem Tarihi 31 veya 28-29 Şubat'a denk geliyorsa diğer aylarda bu günler olmadığı için doğal olarak kodlar hata vermektedir.

Taksit günleri mutlaka her ayın aynı günü mü olması gerekiyor?

 

[akhsahbaz]

Hayır.Zaten göreceğiniz gibi bu bir taksitlendirme programı.Doğal olarak 29 şubat'a denk gelenlerler 1 ine devredebilir. 31 çekenlerde ide aynı şekilde 1 ine devredebilir. Birde dikkatimi çeken 1 girilen değerlerde rapor kısmına geçmiyor. yani raporlamaya çıkmıyor. Bu arada dediğiniz gibi B sütununa değer girince problem yok.

 

[Recep İpek]

O zaman kodları aşağıdaki şekilde değiştiriniz.

Sub Aktar()
Set s1 = Sheets("Form")
Set s2 = Sheets("Rapor")
s2.Range("a2:as1000").ClearContents
For i = 3 To s1.[j65536].End(3).Row 'Form sayfasının 3.satırından j kolonunun son dolu hücresine kadar
    If s1.Cells(i, "j").Value <> "" Then  'e&#287;er h&#252;cre 1'den b&#252;y&#252;k ise
        sat = s2.[a65536].End(3).Row + 1 'Rapor sayfas&#305;ndaki son dolu h&#252;cresinin 1 fazlas&#305;na
        Range(s2.Cells(sat, "a"), s2.Cells(sat, "I")).Value = Range(s1.Cells(i, "b"), s1.Cells(i, "j")).Value  ' Bu sat&#305;r&#305; kopyala
        s2.Cells(sat, "j").Value = s1.Cells(i, "a").Value ' Form sayfas&#305;n&#305;n j kolonuna Rapor sayfas&#305;n&#305;n a kolonunu kopyalaya
        For j = 1 To s1.Cells(i, "j").Value - 1 ' 1'den taksit say&#305;s&#305;n&#305;n 1 eksi&#287;ine kadar.
            tar = CDate(s2.Cells(sat, 9 + j).Value) ' ilgili tarih tar de&#287;i&#351;genine aktar&#305;l&#305;yor
            s2.Cells(sat, 10 + j).Value = DateSerial(Year(tar), Month(tar) + 1, Day(tar)) ' sa&#287;a do&#287;ru ilgili tarihin 1 ay sonras&#305;n&#305; kolona  yaz.
        Next j
    End If
Next i
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[akhsahbaz]

Hocam, 30 ve 31 girişlilerde 3 gün 1 ay kaydırıyor.
30 Ocak>2 Mart olarak çıkıyor
31 Ocak>3 Mart olarak çıkıyor

 

[Recep İpek]

28-29 Şubat'tan kaynaklanıyor.
Başka çözüm bulmak için biraz üzerinde çalışmak gerekiyor..

 

[akhsahbaz]

Vakit ayırdığınız için teşekkür ederim Hocam. Ben baştada söylediğim gibi bunu formülle halletmiştim. Fakat; hem 300 MB ları bulan dosya boyutu, hemde sayfayı form ile süzmeye kalktığımda 25-30 dk ları bulan form açılması sebebi ile bunun tek yolunun makro olacağı düşünüyorum.