• DİKKAT

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

Tatil Günleri Biçimlendirme

C

ckarabacak

Altın Üye
Katılım
12 Ocak 2010
Mesajlar
365
Excel Vers. ve Dili
Excel 2010
Merhaba Arkadaşlar

Ekli Dosyada açıkladığım Sayfada yapılmasını talep ettiğim biçimlendirmeler için yardımlarınızı rica ederim.

İyi Çalışmalar
 

Ekli dosyalar

Kodlarınızda küçük 1-2 revizyon yaptım
C++: 
Option Explicit

Sub Resmi_Tatilleri_Listele()
    Dim Baslangic_Tarihi As Date, Bitis_Tarihi As Date, Tarih As Date
    Dim Ramazan_Bayrami_Baslangic_Tarihi As Date, Satir As Long
    Dim Kurban_Bayrami_Baslangic_Tarihi As Date, X As Long

    
    Baslangic_Tarihi = CDate(Range("h7"))
    
    If Baslangic_Tarihi = 0 Then
        MsgBox "Lütfen başlangıç tarihini giriniz!", vbCritical
        Range("h7").Select
        Exit Sub
    End If
    
    Bitis_Tarihi = CDate(Range("h8"))
    
    If Bitis_Tarihi = 0 Then
        MsgBox "Lütfen bitiş tarihini giriniz!", vbCritical
        Range("h8").Select
        Exit Sub
    End If
    
    If Baslangic_Tarihi = 0 Or Bitis_Tarihi = 0 Then
        MsgBox "Lütfen başlangıç ve bitiş tarihini giriniz!", vbCritical
        Range("h7").Select
        Exit Sub
    End If
    
    If Bitis_Tarihi < Baslangic_Tarihi Then
        MsgBox "Bitiş tarihi başlangıç tarihinden küçük olmamalıdır!", vbCritical
        Range("h8").Select
        Exit Sub
    End If

    Ramazan_Bayrami_Baslangic_Tarihi = CDate(DateSerial(Year(Range("h7")), Range("k4"), Range("j4")))
    
    If Ramazan_Bayrami_Baslangic_Tarihi = 0 Then
        MsgBox "Lütfen RAMAZAN BAYRAMI başlangıç tarihini giriniz!", vbCritical
        Range("j4").Select
        Exit Sub
    End If

    Kurban_Bayrami_Baslangic_Tarihi = CDate(DateSerial(Year(Range("h7")), Range("k5"), Range("j5")))
    
    If Kurban_Bayrami_Baslangic_Tarihi = 0 Then
        MsgBox "Lütfen KURBAN BAYRAMI başlangıç tarihini giriniz!", vbCritical
        Range("j5").Select
        Exit Sub
    End If

    Range("B4:F" & Rows.Count).Clear
    Range("B4:F100").Font.Bold = False

    Satir = 4
    
    For Tarih = Baslangic_Tarihi To Bitis_Tarihi
        If Year(Tarih) >= 1935 And Day(Tarih) = 1 And Month(Tarih) = 1 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Yılbaşı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 1920 And Day(Tarih) = 23 And Month(Tarih) = 4 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Ulusal Egemenlik ve Çocuk Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 2009 And Day(Tarih) = 1 And Month(Tarih) = 5 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Emek ve Dayanışma Günü"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 1935 And Day(Tarih) = 19 And Month(Tarih) = 5 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Atatürk’ü Anma Gençlik ve Spor Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 2016 And Day(Tarih) = 15 And Month(Tarih) = 7 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Demokrasi ve Milli Birlik Günü"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 1935 And Day(Tarih) = 30 And Month(Tarih) = 8 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Zafer Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 1925 And Day(Tarih) = 28 And Month(Tarih) = 10 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Cumhuriyet Bayramı Yarım Gün"
            Cells(Satir, 5) = 0.5
            Cells(Satir, 5).NumberFormat = "# ?/2"
            Cells(Satir, 6) = "Gün"
        End If
        
        If Year(Tarih) >= 1925 And Day(Tarih) = 29 And Month(Tarih) = 10 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Cumhuriyet Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
        
        If Tarih = Ramazan_Bayrami_Baslangic_Tarihi Then
            For X = 1 To 4
                Cells(Satir, 2) = CDate(Tarih + IIf(X = 1, 0, X - 1))
                Cells(Satir, 3) = Format(CDate(Cells(Satir, 2)), "dddd")
                If Cells(Satir, 4) = "" Then
                    Cells(Satir, 4) = "Ramazan Bayramı" & IIf(X = 1, " Yarım Gün", "")
                Else
                    Cells(Satir, 4) = Cells(Satir, 4) & " & Ramazan Bayramı" & IIf(X = 1, " Yarım Gün", "")
                End If
                Cells(Satir, 5) = Cells(Satir, 5) + IIf(X = 1, 0.5, 1)
                Cells(Satir, 5).NumberFormat = IIf(X = 1, "# ?/2", "General")
                Cells(Satir, 6) = "Gün"
                Satir = Satir + 1
            Next
        End If
        
        If Tarih = Kurban_Bayrami_Baslangic_Tarihi Then
            For X = 1 To 5
                Cells(Satir, 2) = CDate(Tarih + IIf(X = 1, 0, X - 1))
                Cells(Satir, 3) = Format(CDate(Cells(Satir, 2)), "dddd")
                If Cells(Satir, 4) = "" Then
                    Cells(Satir, 4) = "Kurban Bayramı" & IIf(X = 1, " Yarım Gün", "")
                Else
                    Cells(Satir, 4) = Cells(Satir, 4) & " & Kurban Bayramı" & IIf(X = 1, " Yarım Gün", "")
                End If
                Cells(Satir, 5) = Cells(Satir, 5) + IIf(X = 1, 0.5, 1)
                Cells(Satir, 5).NumberFormat = IIf(X = 1, "# ?/2", "General")
                Cells(Satir, 6) = "Gün"
                Satir = Satir + 1
            Next
        End If
 
        Satir = Cells(Rows.Count, 2).End(3).Row + 1
        If Satir < 4 Then Satir = 4
    Next

    Columns("B:F").AutoFit
    Columns("F:F").ColumnWidth = Columns("F:F").ColumnWidth + 1
    Range("B3").CurrentRegion.Borders.LineStyle = 1
    For X = 4 To Satir - 1
               If Cells(X, 5) = 0.5 Then Range("B" & X, "F" & X).Font.Bold = True
    Next X
    Range("B4:B" & Satir - 1).Interior.Color = vbYellow
With Range("b4:f20").Font
        Range("b2:f" & Satir - 1).BorderAround Weight:=xlThick, LineStyle:=1
        Columns("b:f").VerticalAlignment = xlCenter
        Columns("b:b").HorizontalAlignment = xlCenter
        Columns("e:e").HorizontalAlignment = xlCenter
        .Name = "Calibri"
        .Size = 12
    End With
Kodl
 
hücre biçimlendirmenize alternatif bir örnek olsun;
Kod: 
Dim HUCRE As Range
For Each HUCRE In Range("B3:B20") 'HUCRE değişkeni B3:B20 arasıdır.
   If Cells(HUCRE.Row, "E") <> 1 Then ' Eğer HUCRE değişkenine ait "E" sütununda bulunan satır 1'e eşit değilse
        Range(Cells(HUCRE.Row, "B"), Cells(HUCRE.Row, "F")).Font.Bold = True 'HUCRE değişkeninin "B" ve "F" sütunlarına ait satırlarını koyu yap
    Else
        Cells(HUCRE.Row, "C").Interior.ColorIndex = 40 'HUCRE değişkeninin "C" sütunlarına ait satırlarını renklerini 40 numaraları renk yap.
    End If
Next
 
Sn. NextLevel ve usubaykan

Yardımlarınız için çok Teşekkür ederim.
İyi çalışmalar
 
Alternatif;

C++: 
Option Explicit

Sub Resmi_Tatilleri_Listele()
    Dim Baslangic_Tarihi As Date, Bitis_Tarihi As Date, Tarih As Date
    Dim Ramazan_Bayrami_Baslangic_Tarihi As Date, Satir As Long
    Dim Kurban_Bayrami_Baslangic_Tarihi As Date, X As Long
   
    Application.ScreenUpdating = False
   
    Baslangic_Tarihi = CDate(Range("H7"))
   
    If Baslangic_Tarihi = 0 Then
        MsgBox "Lütfen başlangıç tarihini giriniz!", vbCritical
        Range("H7").Select
        Exit Sub
    End If
   
    Bitis_Tarihi = CDate(Range("H8"))
   
    If Bitis_Tarihi = 0 Then
        MsgBox "Lütfen bitiş tarihini giriniz!", vbCritical
        Range("H8").Select
        Exit Sub
    End If
   
    If Baslangic_Tarihi = 0 Or Bitis_Tarihi = 0 Then
        MsgBox "Lütfen başlangıç ve bitiş tarihini giriniz!", vbCritical
        Range("H7").Select
        Exit Sub
    End If
   
    If Bitis_Tarihi < Baslangic_Tarihi Then
        MsgBox "Bitiş tarihi başlangıç tarihinden küçük olmamalıdır!", vbCritical
        Range("H8").Select
        Exit Sub
    End If

    Ramazan_Bayrami_Baslangic_Tarihi = CDate(DateSerial(Year(Range("H7")), Range("H4"), Range("J4")))
   
    If Ramazan_Bayrami_Baslangic_Tarihi = 0 Then
        MsgBox "Lütfen RAMAZAN BAYRAMI başlangıç tarihini giriniz!", vbCritical
        Range("J4").Select
        Exit Sub
    End If

    Kurban_Bayrami_Baslangic_Tarihi = CDate(DateSerial(Year(Range("H7")), Range("K5"), Range("J5")))
   
    If Kurban_Bayrami_Baslangic_Tarihi = 0 Then
        MsgBox "Lütfen KURBAN BAYRAMI başlangıç tarihini giriniz!", vbCritical
        Range("J5").Select
        Exit Sub
    End If

    Range("B4:F" & Rows.Count).Clear
    Columns("B:F").VerticalAlignment = xlCenter
    Columns("B:B").HorizontalAlignment = xlCenter
    Columns("E:E").HorizontalAlignment = xlCenter
    Satir = 4
   
    For Tarih = Baslangic_Tarihi To Bitis_Tarihi
        If Year(Tarih) >= 1935 And Day(Tarih) = 1 And Month(Tarih) = 1 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Yılbaşı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Year(Tarih) >= 1920 And Day(Tarih) = 23 And Month(Tarih) = 4 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Ulusal Egemenlik ve Çocuk Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Year(Tarih) >= 2009 And Day(Tarih) = 1 And Month(Tarih) = 5 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Emek ve Dayanışma Günü"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Year(Tarih) >= 1935 And Day(Tarih) = 19 And Month(Tarih) = 5 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Atatürk’ü Anma Gençlik ve Spor Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Year(Tarih) >= 2016 And Day(Tarih) = 15 And Month(Tarih) = 7 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Demokrasi ve Milli Birlik Günü"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Year(Tarih) >= 1935 And Day(Tarih) = 30 And Month(Tarih) = 8 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Zafer Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Year(Tarih) >= 1925 And Day(Tarih) = 28 And Month(Tarih) = 10 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Cumhuriyet Bayramı Yarım Gün"
            Cells(Satir, 5) = 0.5
            Cells(Satir, 5).NumberFormat = "# ?/2"
            Cells(Satir, 6) = "Gün"
            Cells(Satir, 2).Resize(, 5).Font.Bold = True
        End If
       
        If Year(Tarih) >= 1925 And Day(Tarih) = 29 And Month(Tarih) = 10 Then
            Cells(Satir, 2) = CDate(Tarih)
            Cells(Satir, 3) = Format(CDate(Tarih), "dddd")
            Cells(Satir, 4) = "Cumhuriyet Bayramı"
            Cells(Satir, 5) = 1
            Cells(Satir, 6) = "Gün"
        End If
       
        If Tarih = Ramazan_Bayrami_Baslangic_Tarihi Then
            For X = 1 To 4
                Cells(Satir, 2) = CDate(Tarih + IIf(X = 1, 0, X - 1))
                Cells(Satir, 3) = Format(CDate(Cells(Satir, 2)), "dddd")
                If Cells(Satir, 4) = "" Then
                    Cells(Satir, 4) = "Ramazan Bayramı" & IIf(X = 1, " Yarım Gün", "")
                Else
                    Cells(Satir, 4) = Cells(Satir, 4) & " & Ramazan Bayramı" & IIf(X = 1, " Yarım Gün", "")
                End If
                Cells(Satir, 5) = Cells(Satir, 5) + IIf(X = 1, 0.5, 1)
                Cells(Satir, 5).NumberFormat = IIf(X = 1, "# ?/2", "General")
                Cells(Satir, 6) = "Gün"
                Cells(Satir, 2).Resize(, 5).Font.Bold = IIf(X = 1, True, False)
                Satir = Satir + 1
            Next
        End If
       
        If Tarih = Kurban_Bayrami_Baslangic_Tarihi Then
            For X = 1 To 5
                Cells(Satir, 2) = CDate(Tarih + IIf(X = 1, 0, X - 1))
                Cells(Satir, 3) = Format(CDate(Cells(Satir, 2)), "dddd")
                If Cells(Satir, 4) = "" Then
                    Cells(Satir, 4) = "Kurban Bayramı" & IIf(X = 1, " Yarım Gün", "")
                Else
                    Cells(Satir, 4) = Cells(Satir, 4) & " & Kurban Bayramı" & IIf(X = 1, " Yarım Gün", "")
                End If
                Cells(Satir, 5) = Cells(Satir, 5) + IIf(X = 1, 0.5, 1)
                Cells(Satir, 5).NumberFormat = IIf(X = 1, "# ?/2", "General")
                Cells(Satir, 6) = "Gün"
                Cells(Satir, 2).Resize(, 5).Font.Bold = IIf(X = 1, True, False)
                Satir = Satir + 1
            Next
        End If
       
        Satir = Cells(Rows.Count, 2).End(3).Row + 1
        If Satir < 4 Then Satir = 4
    Next

    With Range("B4:F" & Satir - 1)
        .Font.Name = "Calibri"
        .Font.Size = 12
        .Columns(1).Interior.Color = 10092543
    End With
       
    Range("B3").CurrentRegion.Borders.LineStyle = 1
    Columns("B:F").AutoFit

    Application.ScreenUpdating = True
   
    MsgBox "Seçtiğiniz tarih aralığına göre resmi tatiller listelenmiştir.", vbInformation
End Sub
 
Korhan Hocam Merhaba

İlginiz ve yardımlarınız için Teşekkür ederim.

İyi Akşamlar dilerim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst