Çözüldü Takvim

[sirkülasyon]

A4 Hücresine Ay adı yazılı (Ocak, Şubat, Mart gibi...)

A5 hücresinden itibaren alta doğru A4 hücresine yazılan ay adına göre tarihleri Haftasonu hariç olarak yazmak için formül konusunda yardımcı olabilir misiniz?

Saygılarımla

 

[askm]

Formülle değil ama makro ile istediğiniz işlem aşağıdaki şekilde olur.

Sub askm()
On Error GoTo son
Dim ay, tarih
Dim a As Integer
ay = Month(DateValue("01/" & Range("A4").Value & "/2019"))
a = 5
Application.ScreenUpdating = False
Range("a5:a50").ClearContents
For i = 1 To 31
    tarih = DateSerial(Year(Now), ay, i)
    If Month(tarih) <> ay Then Exit For
    If Application.Weekday(tarih) <> 1 And Application.Weekday(tarih) <> 7 Then
        Cells(a, 1) = tarih
        a = a + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
Exit Sub
son:
MsgBox "Ay ismi hatalı girildi...", vbInformation, "ASKM"
End Sub

 

[Ömer BARAN]

Merhaba.
A5'e uygulayın ve aşağı doğru A27'ye kadar kopyalayın.

=EĞER($A$4="";"";EĞER(TAMİŞGÜNÜ(0+("1 "&$A$4&" 2019");SERİAY(0+("1 "&$A$4&" 2019");0))<SATIR()-4;"";
EĞER(SATIR()=5;0+("1 "&$A$4&" 2019");A4+1)+ARA(HAFTANINGÜNÜ(EĞER(SATIR()=5;0+("1 "&$A$4&" 2019");A4+1);2);{1;6;7};{0;2;1})))

 

[52779]

Alternatif olarak
http://s7.dosya.tc/server13/ox6uig/Ay-Tarih_HaftaIci.xlsx.html

Kullanılan Ad Tanımlamaları:
Bas =("1."&Sayfa1!$A$4&"."&Sayfa1!$B$4)*1
Bit =SERİAY(Bas;0)
Tar =SATIR(DOLAYLI("A"&Bas&":A"&Bit))

A4 hücresinde AY ve B4 hücresinde YIL yazılı
A5 hücresinde
=EĞERHATA(GÜN(İNDİS(Tar;KÜÇÜK(EĞER(HAFTANINGÜNÜ(Tar;2)<=5;SATIR(DOLAYLI("A1:A"&Bit-Bas+1)));SATIRSAY($1:1))));"")
Dizi formülü mevcut. Formül A28 hücresine kadar kopyalandı. B5:B28 hücrelerinde ise günler yazmakta..

 

[Ömer BARAN]

Tekrar merhaba.
3 numaralı cevapta formül ile çözüm vermiştim.
Bu da makro ile çözüm alternatifi olsun.

Kod'u, alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranda sağ taraftaki alana yapıştırın.
A4'e ay adını yazıp ENTER tuşuna basın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A4]) Is Nothing Then Exit Sub
On Error GoTo bitti
[A5:A27].ClearContents: ilk = DateValue("01/" & Target.Value & "/2019")
For gun = 1 To Day(WorksheetFunction.EoMonth(DateValue(ilk), 0))
    If WorksheetFunction.Weekday(ilk + gun - 1, 2) = 6 Then gun = gun + 2
    If Month(CDate(ilk + gun - 1)) <> Month(ilk) Then Exit For
    Cells(Cells(Rows.Count, 1).End(3).Row + 1, 1) = CDate(ilk + gun - 1)
Next
bitti:
End Sub

 

[sirkülasyon]

Allah cc hepinizden razı olsun. Hakkınızı helal ediniz.
Yardımlarını esirgemeyen
askm, 52779, Ömer BARAN ustalarıma da ayrı ayrı teşekkür ederim.

 

[okan32]

Tekrar merhaba.
3 numaralı cevapta formül ile çözüm vermiştim.
Bu da makro ile çözüm alternatifi olsun.

Kod'u, alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranda sağ taraftaki alana yapıştırın.
A4'e ay adını yazıp ENTER tuşuna basın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A4]) Is Nothing Then Exit Sub
On Error GoTo bitti
[A5:A27].ClearContents: ilk = DateValue("01/" & Target.Value & "/2019")
For gun = 1 To Day(WorksheetFunction.EoMonth(DateValue(ilk), 0))
    If WorksheetFunction.Weekday(ilk + gun - 1, 2) = 6 Then gun = gun + 2
    If Month(CDate(ilk + gun - 1)) <> Month(ilk) Then Exit For
    Cells(Cells(Rows.Count, 1).End(3).Row + 1, 1) = CDate(ilk + gun - 1)
Next
bitti:
End Sub

Ömer Bey öncelikle yardımlarınız için teşekkür ederim. kodu denedim ama bazı aylarda hata veriyor. mesela mayıs ayını getirmiyor

 

[okan32]

özür dilerim ömer bey ben yanlış yazmışım sıkıntı yok kod gayet güzel çalışıyor