AccessTr.neT - Yıllık İcmal Almak

Sayfalar: 1 2 3 4

(09/05/2021, 12:23)feraz yazdı: [ -> ]
(09/05/2021, 12:06)hayalibey yazdı: [ -> ]
(09/05/2021, 11:43)feraz yazdı: [ -> ]
(09/05/2021, 03:42)hayalibey yazdı: [ -> ]Bu işlemi her yıl 15 Hazirandan sonra dosya ilk açıldığında 1 kere yapması gerekiyor.
Ben kodu çalıştırınca eklettim.O kısmı görmemişim.15 hazirandan sonra sonra kod çalıştırmasını yaparızda 1 defa naıl çalıştırılır onu bilmiyorum.Belki bir sayfa ekleyip bir hücresine 1 kere çalışınca 1 yazdırılıp bir dahaki seneyi bekletilebilinir yoksa zor ihtimal abey bence.Kodu ayarlarsam eklerim bugün.

Hocam aşağıdaki kodu revize etsek
Misal icmal_2 sayfası n1 hücresine 2020 yazsak
Her yıl 15 haziranda açılınca yılı 1 arttırsa

Kod:
Aşağıda bir şeyler yapmaya çalıştım ama takıldım olmadı yani Visual Basic Code Private Sub Workbook_Open() Set vs = ThisWorkbook.Sheets("İCMAL_2") If Date > DateValue("15/06/" & vs.[N1] + 1) Then vs.[N1] = Year(Date) - 1 If Date >= DateValue("15/06/" & vs.[N1]) And _ Date <= DateValue("14/06/" & vs.[N1] + 1) Then İşlem Kodları gelse sonrasında vs.[N1] = vs.[N1] + 1 End If End Sub

O koda gerek kalmadan ayarlayacağım Allah'ın izniyle abey

Teşekkür ederim Zafer Hocam

Rica edrim abey.
Ben tarih ve yılları değiştirip kodu denedim çalıştı sizde teferruatlıca deneyin.Önceki mesajdayazdığım sayfa ekleme olayını yapmadım.
Ben kodu resimdeki gibi bir modül içindeki sub Autoopen içine ekledim siz workbooksopen içinede ekleyebilirsiniz sub ve end sunb arasındaki kodları.
workbookopen e eklememin sebebi bazen çalışmıyor bende lakin ikiside Excel açılışında çalıştırıyor kodları.

Bu arada yazılımcılar bas bas bağırıyorlar Türkçe karakterler kullanmayın sayfada vs.. diye herkeste tersini uyguluyor Img-grin

https://resim.accesstr.net/do.php?img=11002

Sub Auto_open()

Dim sonSut As Integer, tar As Range, son As Long

Dim syfYillikicmaL_2 As Worksheet, dolumu As Long



If Day(Date) < 15 Then Exit Sub

If Month(Date) < 5 Then Exit Sub



Set syfYillikicmaL_2 = ThisWorkbook.Sheets("İCMAL_2")

dolumu = 0

With ThisWorkbook.Sheets("YILLIK_İCMAL")

    sonSut = .Cells(1, Columns.Count).End(xlToLeft).Column

    If sonSut < 2 Then Exit Sub

    son = syfYillikicmaL_2.Cells(Rows.Count, 1).End(3).Row

    For Each tar In .Range(.Cells(1, 2), .Cells(1, sonSut))

        If tar.Value = Year(Date) Then

            dolumu = WorksheetFunction.CountA(.Range(.Cells(1, tar.Column), .Cells(Rows.Count, tar.Column)))

            If dolumu > 1 Then GoTo var

            syfYillikicmaL_2.Range("A2:A" & son).Copy .Cells(2, 1)

            syfYillikicmaL_2.Range("F2:F" & son).Copy .Cells(2, tar.Column)

            Exit For

        End If

    Next

End With



Application.CutCopyMode = False

Set tar = Nothing: Set syfYillikicmaL_2 = Nothing

MsgBox "Bitti"

var:

Set tar = Nothing: Set syfYillikicmaL_2 = Nothing

End Sub

(09/05/2021, 12:37)feraz yazdı: [ -> ]dolumu As Byte

Eğer yıl sütunlarında satır sayısı 256 dan fazla olacaksa byte yerine Long yazın abey.

Zafer Hocam teferruatli deneyip size bilgi vereyim

(09/05/2021, 12:37)feraz yazdı: [ -> ]syfYillikicmaL_2.Range("A2:A" & son).Copy .Cells(2, 1)

Abey önceki mesajdaki yukardaki kod gereksiz olmuş onu silin.Çünkü zaten eklemişsiniz.
Ayrıca yıllar otomatik oluşsun derseniz gifi izleyin ve ekteki dosyayı deneyin.
Kod zaten 16/6 dan önce olursa çalışmaz göstermek için böyle yaptım.

(09/05/2021, 16:01)feraz yazdı: [ -> ]
(09/05/2021, 12:37)feraz yazdı: [ -> ]syfYillikicmaL_2.Range("A2:A" & son).Copy .Cells(2, 1)
Abey önceki mesajdaki yukardaki kod gereksiz olmuş onu silin.Çünkü zaten eklemişsiniz.
Ayrıca yıllar otomatik oluşsun derseniz gifi izleyin ve ekteki dosyayı deneyin.
Kod zaten 16/6 dan önce olursa çalışmaz göstermek için böyle yaptım.

[img]https://s3.gifyu.com/images/aaaa6c43e1a612577cef.gif

(09/05/2021, 18:49)hayalibey yazdı: [ -> ] 
(09/05/2021, 16:01)feraz yazdı: [ -> ] 
(09/05/2021, 12:37)feraz yazdı: [ -> ] syfYillikicmaL_2.Range("A2:A" & son).Copy .Cells(2, 1) 
 Abey önceki mesajdaki yukardaki kod gereksiz olmuş onu silin.Çünkü zaten eklemişsiniz. Ayrıca yıllar otomatik oluşsun derseniz gifi izleyin ve ekteki dosyayı deneyin. Kod zaten 16/6 dan önce olursa çalışmaz göstermek için böyle yaptım.

Hocam yolladığınız dosya harika çalışıyor ama ben kendi projeme ekleyemed
m bir türlü hata veriyor . Halbuki kopyala modülünü olduğu gibi aldım. Zafer Hocam tam olarak nerede hata yapıyorum
[url=https://gifyu.com/image/5RBu[/url]

Sayfalar: 1 2 3 4