Soru Kenarlık

[sirkülasyon]

Dim Ay As Byte, İlk_Gün As Date, Son_Gün As Date, Tarih As Date, Satır As Byte

Range("B6:H31").ClearContents
Satır = 6

Select Case Range("C2")
Case Is = "Ocak": Ay = 1
Case Is = "Şubat": Ay = 2
Case Is = "Mart": Ay = 3
Case Is = "Nisan": Ay = 4
Case Is = "Mayıs": Ay = 5
Case Is = "Haziran": Ay = 6
Case Is = "Temmuz": Ay = 7
Case Is = "Ağustos": Ay = 8
Case Is = "Eylül": Ay = 9
Case Is = "Ekim": Ay = 10
Case Is = "Kasım": Ay = 11
Case Is = "Aralık": Ay = 12
End Select

İlk_Gün = DateSerial(Range("C1"), Ay, 1)
Son_Gün = DateSerial(Range("C1"), Ay + 1, 0)

For Tarih = İlk_Gün To Son_Gün
If Weekday(Tarih, vbMonday) < 6 Then
Cells(Satır, 2) = Tarih
Cells(Satır, 3) = Format(Tarih, "dddd")
Satır = Satır + 1
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation

B6:H31 aralığına seçilen Yıl ve Ay gün sayısı kadar
Kenarlıkları Çift çizgili
İçi normal çizgili olacak şekilde nasıl bir kod olabilir?
Yardımcı olabilir misiniz?

 

[tukayf]

Hocam kod bilmiyorum ama önce koşullu yapıp makro kaydettikten sonra koda ekleseniz çözüm olmuyor mu

 

[Necdet]

Deneyiniz

Sub Test()

    Dim Satır As Integer, _
        İlk_Gün As Date, _
        Son_gün As Date
    
    Application.ScreenUpdating = False
    
    With Range("B6:H31")
        .ClearContents
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    
    Satır = 6
    
    Select Case Range("C2")
        Case Is = "Ocak": Ay = 1
        Case Is = "Şubat": Ay = 2
        Case Is = "Mart": Ay = 3
        Case Is = "Nisan": Ay = 4
        Case Is = "Mayıs": Ay = 5
        Case Is = "Haziran": Ay = 6
        Case Is = "Temmuz": Ay = 7
        Case Is = "Ağustos": Ay = 8
        Case Is = "Eylül": Ay = 9
        Case Is = "Ekim": Ay = 10
        Case Is = "Kasım": Ay = 11
        Case Is = "Aralık": Ay = 12
    End Select
    
    İlk_Gün = DateSerial(Range("C1"), Ay, 1)
    Son_gün = DateSerial(Range("C1"), Ay + 1, 0)
    
    For Tarih = İlk_Gün To Son_gün
        If Weekday(Tarih, vbMonday) < 6 Then
            Cells(Satır, 2) = Tarih
            Cells(Satır, 3) = Format(Tarih, "dddd")
            Satır = Satır + 1
        End If
    Next
    
    Border
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
End Sub

Sub Border()

    Dim i As Integer
    Dim rng As Range
    
    i = Range("B6").End(xlDown).Row
    Set rng = Range("B6:H" & i)
    
    
    With rng.Borders(xlEdgeLeft)
        .LineStyle = xlDouble
        .ThemeColor = 1
        .TintAndShade = -0.49
        .Weight = xlThick
    End With
    With rng.Borders(xlEdgeTop)
        .LineStyle = xlDouble
        .ThemeColor = 1
        .TintAndShade = -0.49
        .Weight = xlThick
    End With
    With rng.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ThemeColor = 1
        .TintAndShade = -0.49
        .Weight = xlThick
    End With
    With rng.Borders(xlEdgeRight)
        .LineStyle = xlDouble
        .ThemeColor = 1
        .TintAndShade = -0.49
        .Weight = xlThick
    End With
    With rng.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.49
        .Weight = xlThin
    End With
    With rng.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.49
        .Weight = xlThin
    End With
    
    Set rng = Nothing
    
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Workday_List()
    Dim Ay As Byte, İlk_Gün As Date, Son_Gün As Date, Tarih As Date, Satır As Byte
    
    Range("B6:H31").Clear
    Satır = 6
    
    Select Case Range("C2")
        Case Is = "Ocak": Ay = 1
        Case Is = "Şubat": Ay = 2
        Case Is = "Mart": Ay = 3
        Case Is = "Nisan": Ay = 4
        Case Is = "Mayıs": Ay = 5
        Case Is = "Haziran": Ay = 6
        Case Is = "Temmuz": Ay = 7
        Case Is = "Ağustos": Ay = 8
        Case Is = "Eylül": Ay = 9
        Case Is = "Ekim": Ay = 10
        Case Is = "Kasım": Ay = 11
        Case Is = "Aralık": Ay = 12
    End Select
    
    İlk_Gün = DateSerial(Range("C1"), Ay, 1)
    Son_Gün = DateSerial(Range("C1"), Ay + 1, 0)
    
    For Tarih = İlk_Gün To Son_Gün
        If Weekday(Tarih, vbMonday) < 6 Then
            Cells(Satır, 2) = Tarih
            Cells(Satır, 3) = Format(Tarih, "dddd")
            Satır = Satır + 1
        End If
    Next
    
    With Range("B6:H" & Satır - 1)
        .BorderAround LineStyle:=xlDouble
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[sirkülasyon]

Her iki Üstadıma da (Necdet ve Korhan Ayhan) ayrı ayrı teşekkür ederim.