Skip to main content

AccessTr.neT


Yıllık İcmal Almak

Yıllık İcmal Almak

#7
(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 Img-grin

Teşekkür ederim Zafer Hocam
Cevapla
#8
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

[Resim: do.php?img=11002]
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
.rar YILLIK İCMAL.rar (Dosya Boyutu: 16,28 KB | İndirme Sayısı: 0)
Cevapla
#9
(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.
Cevapla
#10
Zafer Hocam teferruatli deneyip size bilgi vereyim
Cevapla
#11
(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.

[Resim: aaaa6c43e1a612577cef.gif]
.rar YILLIK İCMAL otomatik tarih.rar (Dosya Boyutu: 17,89 KB | İndirme Sayısı: 3)
Cevapla
#12
(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<br />
<br />
<br />
(09/05/2021, 18:49)hayalibey yazdı: <br />
(09/05/2021, 16:01)feraz yazdı: <br />
(09/05/2021, 12:37)feraz yazdı: <br />syfYillikicmaL_2.Range("A2:A" & son).Copy .Cells(2, 1)<br />
<br />Abey önceki mesajdaki yukardaki kod gereksiz olmuş onu silin.Çünkü zaten eklemişsiniz.<br />Ayrıca yıllar otomatik oluşsun derseniz gifi izleyin ve ekteki dosyayı deneyin.<br />Kod zaten 16/6 dan önce olursa çalışmaz göstermek için böyle yaptım.<br /><br />[Resim: aaaa6c43e1a612577cef.gif]

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]
.rar hata mesajı.rar (Dosya Boyutu: 69,74 KB | İndirme Sayısı: 1)
Son Düzenleme: 09/05/2021, 18:54, Düzenleyen: hayalibey.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task