Açılır Liste ile Takvim Oluşturma

[akayemrecan]

Herkese hayırlı günler. Benim bir personel listem var arkadaşlar. Bu personelin takibini yapmak için belge hazırladım. A sütununda isimler, 1 nolu satırda da Ekim ayının tarihleri var. A1 hücresi de boş. Ben açılır liste vasıtası ile ayı ve yılı seçtiğim zaman 1. satırdaki tüm tarihler güncellensin istiyorum. Mümkün müdür?
1. Satırda
b1 1 Ekim
b2 2 Ekim diye gidiyor.

 

[recepkull]

Aşağıdaki kod işinizi görür sanırım. A1 hücresine ay ve yılı yazın (Örn. Ekim 2023) sağındaki hücrelere günler sıralanacak.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then
    Dim baslangic As Date
    Dim bitis As Date
    Dim i As Integer
    Cells(1, 2).Resize(1, 32).Value = ""
    baslangic = Range("A1").Value
    bitis = DateSerial(Year(baslangic), Month(baslangic) + 1, 1) - 1
    For i = 0 To (bitis - baslangic)
        
        Cells(1, i + 2).Value = Format(baslangic + i, "d mmmm")
    Next i
End If
End Sub

 

[Necdet]

Merhaba,
Alternatif olsun.
B1 hücresine istediğiniz tarihi girin (Örneğin 1 Ekim 2023 için : 1/3/23 ya da 1-3-23 gibi)
B2 :

=EĞER(AY($B$1+SATIR(B1))=AY($B$1);$B$1+SATIR(B1);"")

B2 deki formülü istediğiniz kadar alt satıra kopyalayın.
sonraki zamanlarda sadece b1 hücresini değiştirdiğinizde alt satırlar ilgili ayın tarihleri olacaktır.

Hücrede 1 Ekim gibi görünmesini istiyorsanız B sütununu seçin

• Biçim
• Hücre biçimlendirme
• Sayı : İsteğe uyarlanmış
• Tür : gg aaaa
• Tamam

 

[akayemrecan]

Aşağıdaki kod işinizi görür sanırım. A1 hücresine ay ve yılı yazın (Örn. Ekim 2023) sağındaki hücrelere günler sıralanacak.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then
    Dim baslangic As Date
    Dim bitis As Date
    Dim i As Integer
    Cells(1, 2).Resize(1, 32).Value = ""
    baslangic = Range("A1").Value
    bitis = DateSerial(Year(baslangic), Month(baslangic) + 1, 1) - 1
    For i = 0 To (bitis - baslangic)
       
        Cells(1, i + 2).Value = Format(baslangic + i, "d mmmm")
    Next i
End If
End Sub

hocam öncelikle ellerinize sağlık. bunu denedim fakat çalıştıramadım. bir buton ekleyip kodları butona yazdım ama çalışmadı.

 

[Necdet]

3 nolu mesaj için görüşleriniz nedir?

 

[akayemrecan]

3 nolu mesaj için görüşleriniz nedir?

Hocam ellerinize sağlık fakat sizin yazdığınız kod tam istediğim kod fakat ben tarihi sütuna değil satıra dağıtacağım. Nasıl düzenleyeceğimi anlayamadım.

 

[recepkull]

hocam öncelikle ellerinize sağlık. bunu denedim fakat çalıştıramadım. bir buton ekleyip kodları butona yazdım ama çalışmadı.

Benim yazdığım kodda buton eklemenize gerek yok. Yukardaki kodu sayfanın kod bölümüne ekleyin ardından A1 hücresine istediğiniz tarihi yazın kod otomatik çalışacaktır.

 

[Necdet]

Hocam ellerinize sağlık fakat sizin yazdığınız kod tam istediğim kod fakat ben tarihi sütuna değil satıra dağıtacağım. Nasıl düzenleyeceğimi anlayamadım.

Zaten satıra yazıyor.
B1 e siz tarihi yazıyorsunuz B2 ye formülü yazıyorsunuz
B2 deki formül aşağıya doğru kopyalıyorsunuz, b3,b4 b....30 gibi,
Siz neyi yanlış yaptınız ki onu anlamadım.

 

[akayemrecan]

Benim yazdığım kodda buton eklemenize gerek yok. Yukardaki kodu sayfanın kod bölümüne ekleyin ardından A1 hücresine istediğiniz tarihi yazın kod otomatik çalışacaktır.

Hocam çok güzel çalıştı ellerinize sağlık. Nokta atış istediğimi yapıyor. Peki ben ilk hücreye tarihi yazdığımda 1. ocak yazıyorum mesela ikinci hücrenin 1. ocak yerine iki ocak ile başlamasını nasıl sağlayabilirim?

 

[recepkull]

Koddaki baslangic = Range("A1").Value satırını
baslangic = Range("A1").Value+1 olarak değiştirin.

 

[akayemrecan]

Koddaki baslangic = Range("A1").Value satırını
baslangic = Range("A1").Value+1 olarak değiştirin.

çok sağolun hocam.