Skip to main content

AccessTr.neT


Yıllık İcmal Almak

Yıllık İcmal Almak

Çözüldü #1
Herkese Merhaba
Ekli dosyada İCMAL_2 sayfasında bulunan verileri macro ile Toplam başlığı altında topluyorum.

Benim yapamadığım :
Her yıl 15 Haziran tarihinden sonra
Excel ilk açılışında İCMAL_2 sayfası toplam başlığı altında olan verileri kopyalayıp YILLIK_İCMAL sayfasında örnekte gösterdiğim gibi 1. sütunlara başlık olarak içinde bulunduğu yılı yazarak altına İCMAL_2 de toplam başlığı altındaki verileri kopyalaması ve tablo yapması

Ben örnek olarak bir kaç yıl ekledim. Ama otomotik olarak içinde bulunduğu yılı 1. Satıra eklemesi gerekiyor. 2022 olunca kopyalamaya 2022 satırının altına 2023 olunca eski verilere dokunmadan 2023 altında toplam verileri kopyalacak.
Yardımcı olabilecek olan varsa çok sevinirim.

Konuyu yeniden izah etmeye çalışayım.
her yıl 15 Hazirandan sonra dosya her açılışında YILLIK_İCMAL sayfasının b sütunundan başlamak üzere
içinde bulunduğumuz yıl 2021 .
O halde B1 de 2021 yazacak ve İCMAL_2 sayfamızın F2 F18 arasını kopyalayarak YILLIK_İCMAL sayfasına B2 B18 arasına kopyalayacak
içinde bulunduğumuz yıl 2022 .
O halde C1 de 2022 yazacak ve İCMAL_2 sayfamızın F2 F18 arasını kopyalayarak YILLIK_İCMAL sayfasına C2 C18 arasına kopyalayacak
içinde bulunduğumuz yıl 2023
O halde D1 de 2023 yazacak ve İCMAL_2 sayfamızın F2 F18 arasını kopyalayarak YILLIK_İCMAL sayfasına D2 D18 arasına kopyalayacak

Aşağıda bir şeyler yapmaya çalıştım ama takıldım olmadı yani

    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
.rar YILLIK İCMAL.rar (Dosya Boyutu: 8,17 KB | İndirme Sayısı: 4)
Son Düzenleme: 08/05/2021, 22:44, Düzenleyen: hayalibey.
Cevapla
#2
Merhaba.Kodu deneyiniz.

Sub kopyala()
Dim sonSut As Integer, tar As Range, son As Long

With Sheets("YILLIK_ÝCMAL")
    sonSut = .Cells(1, Columns.Count).End(xlToLeft).Column
    If sonSut < 2 Then Exit Sub
    son = Sheets("ÝCMAL_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
            Sheets("ÝCMAL_2").Range("A2:A" & son).Copy .Cells(2, 1)
            Sheets("ÝCMAL_2").Range("F2:F" & son).Copy .Cells(2, tar.Column)
            Exit For
        End If
    Next
End With
Application.CutCopyMode = False
Set tar = Nothing
MsgBox "Bitti"
End Sub
Cevapla
#3
(09/05/2021, 00:37)feraz yazdı: Merhaba.Kodu deneyiniz.

Sub kopyala()
Dim sonSut As Integer, tar As Range, son As Long

With Sheets("YILLIK_ÝCMAL")
    sonSut = .Cells(1, Columns.Count).End(xlToLeft).Column
    If sonSut < 2 Then Exit Sub
    son = Sheets("ÝCMAL_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
            Sheets("ÝCMAL_2").Range("A2:A" & son).Copy .Cells(2, 1)
            Sheets("ÝCMAL_2").Range("F2:F" & son).Copy .Cells(2, tar.Column)
            Exit For
        End If
    Next
End With
Application.CutCopyMode = False
Set tar = Nothing
MsgBox "Bitti"
End Sub

Zafer Hocam kafam karıştı.
Bu işlemi her yıl 15 Hazirandan sonra dosya ilk açıldığında 1 kere yapması gerekiyor.
Yine YILLIK_İCMAL Sayfasında 1. Satırlarda içinde bulunduğu yıl yoksa 1. satırdaki ilk boş satıra içinde bulunduğu yılı yazıp altına kopyalayıp tablo yapacak .
Cevapla
#4
(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 nası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.
Cevapla
#5
(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

Cevapla
#6
(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
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task