• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çözüldü Ay Son Gününü belirleyememe

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
Kod:
   Dim Sayfa As Worksheet
    Dim yearValue As Integer
    Dim monthValue As Integer
    Dim firstDay As Date
    Dim lastDay As Date
    Dim daysInMonth As Integer
    Set Sayfa = Sheets("İmza Föyü")
    yearValue = Sayfa.Range("E6").Value
    monthValue = Sayfa.Range("F6").Value
    Sayfa.Range("J3").Value = Format(DateSerial(yearValue, monthValue, 1), "dd.mm.yyyy")
    Sayfa.Range("A1").Value = Format(DateSerial(1, monthValue, 1), "mmmm")
    daysInMonth = Day(DateSerial(1, monthValue + 1, 0))
    Sayfa.Range("A2").Value = daysInMonth
    Sayfa.Range("J4").Value = Format(DateSerial(yearValue, monthValue, 1), "dd.mm.yyyy")
    Sayfa.Range("J5").Value = Format(DateSerial(yearValue, monthValue, daysInMonth), "dd.mm.yyyy")
    For i = 9 To 24
        Sayfa.Cells(i, 3).Value = i - 8
        Sayfa.Cells(i, 4).Value = Format(DateSerial(1, monthValue, i - 8), "dddd")
    Next i
    For i = 9 To 24
        Sayfa.Cells(i, 7).Value = i + 8
        Sayfa.Cells(i, 8).Value = Format(DateSerial(1, monthValue, i + 8), "dddd")
    Next i
    For i = 9 To 24
        If Sayfa.Cells(i, 4).Value = "Cumartesi" Or Sayfa.Cells(i, 4).Value = "Pazar" Then
            Sayfa.Range("C" & i & ":F" & i).Interior.Color = RGB(190, 190, 190) ' Yellow
        End If
        If Sayfa.Cells(i, 8).Value = "Cumartesi" Or Sayfa.Cells(i, 8).Value = "Pazar" Then
            Sayfa.Range("G" & i & ":J" & i).Interior.Color = RGB(190, 190, 190) ' Yellow
        End If
    Next i
A1 Hücresinde ay Adı (Ocak, Şubat, Mart) yazılı
A2 hücresinde de Ayın Gün Sayısı (30, 31, 28) yazılı
For i = 9 To 24 Sayfa.Cells(i, 7).Value = i + 8 Sayfa.Cells(i, 8).Value = Format(DateSerial(1, monthValue, i + 8), "dddd") Next i
kısmını A2 hücresindeki ay gün sayısı olacak şekilde sınırlandıramadım.
Rica etsem yardımcı olabilir misiniz?
 
Merhaba;
Üst taraftaki kodlarınıza bakmadım ama alt taraftaki sorunuza;

Sub düzenleme()
sat = 9
For i = 0 To Cells(2, 1) - 1
Cells(sat, 7).Value = i + 1
Cells(sat, 8).Value = Format(DateSerial(1, monthValue, i + 1), "dddd")
sat = sat + 1
Next i
End Sub

Şeklinde deneyin.
İyi çalışmalar.
 
Merhaba
Kod:
 Dim Sayfa As Worksheet
    Dim yearValue As Integer
    Dim monthValue As Integer
    Dim firstDay As Date
    Dim lastDay As Date
    Dim daysInMonth As Integer, ikinci As Integer
    Set Sayfa = Sheets("İmza Föyü")
    yearValue = Sayfa.Range("E6").Value
    monthValue = Sayfa.Range("F6").Value
    Sayfa.Range("J3").Value = Format(DateSerial(yearValue, monthValue, 1), "dd.mm.yyyy")
    Sayfa.Range("A1").Value = Format(DateSerial(1, monthValue, 1), "mmmm")
    daysInMonth = Day(DateSerial(1, monthValue + 1, 0))
    Sayfa.Range("A2").Value = daysInMonth
    Sayfa.Range("J4").Value = Format(DateSerial(yearValue, monthValue, 1), "dd.mm.yyyy")
    Sayfa.Range("J5").Value = Format(DateSerial(yearValue, monthValue, daysInMonth), "dd.mm.yyyy")
    Sayfa.Range(Cells(9, 3), Cells(24, 10)).Clear

    For i = 1 To Application.WorksheetFunction.RoundUp(daysInMonth / 2, 0)
        Sayfa.Cells(i + 8, 3).Value = i
        Sayfa.Cells(i + 8, 4).Value = Format(DateSerial(yearValue, monthValue, i - 0), "dddd")
        ikinci = Application.WorksheetFunction.RoundUp(i + (daysInMonth / 2), 0)
        If ikinci <= daysInMonth Then
            Sayfa.Cells(i + 8, 7).Value = ikinci
            Sayfa.Cells(i + 8, 8).Value = Format(DateSerial(yearValue, monthValue, ikinci), "dddd")
        End If
        If Sayfa.Cells(i + 8, 4).Value = "Cumartesi" Or Sayfa.Cells(i + 8, 4).Value = "Pazar" Then
            Sayfa.Range("C" & i + 8 & ":F" & i + 8).Interior.Color = RGB(190, 190, 190) ' Yellow
        End If
        If Sayfa.Cells(i + 8, 8).Value = "Cumartesi" Or Sayfa.Cells(i + 8, 8).Value = "Pazar" Then
            Sayfa.Range("G" & i + 8 & ":J" & i + 8).Interior.Color = RGB(190, 190, 190) ' Yellow
        End If
    Next i
 
Muygun ve Necati ustama teşekkür ederim. Ellerinize sağlık
 
Geri
Üst