2 Tarih Arası Çizelge Oluşturmak

[1Al2Ver]

Merhaba,

Ek'li dosyada "ÇOKLU_LİSTE" sayfasında,

2 tarih arası için "B3" ten itibaren, her gün için ; "A1" deki sayı adedi kadar satır eklenmiş bir çizelge elde etmek istiyorum,

Teşekkür ederim.

 

[dEdE]

Merhaba,
Örnek dosyanızdan bunu anladım. Kodu örnek dosyanıza ekleyerek dener misiniz?

Sub Test1()
t1 = [B1]
gün = [D1] - t1 + 1
sat = 3
ss = Cells(Rows.Count, "B").End(3).Row + 1
Range("A3:H" & ss + [A1]).Delete Shift:=xlUp

For j = 1 To gün
        Cells(sat, 1) = Format(t1, "dddd")
        Cells(sat, 2) = t1
        Range(Cells(sat, 1), Cells(sat, 2)).Font.Color = vbRed
        sat = sat + [A1].Value
    t1 = t1 + 1
Next j

ss1 = Cells(Rows.Count, "B").End(3).Row
For k = 3 To ss1 Step [A1]
    With Range("A" & k & ":H" & k - 1 + [A1])
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
    End With
Next k

For m = 1 To 7
    Range(Cells(2, m), Cells(ss1 + [A1] - 1, m)).Borders(xlEdgeRight).Weight = xlThin
Next m
End Sub

 

[1Al2Ver]

Sayın dEdE merhaba,

İlginiz ve çözüm için çok teşekkür ederim, kod'un işleyişi mükemmel.

Bir nokta da daha çözüm arzuluyorum ;

Günlerin ve tarihlerin hücreleri ( örneğin 3 satır için A4, A5 te Salı, B4 B5 te de 01.11.2022) üstteki satırın verisini içerecek ama yazı rengi beyaz olacak,

(İlk mesaj ekindeki dosyamda "A3:B11" arasına örneklemiştim, diğerlerinin boş gözükmesi ( örneğin ; A13, B13 gibi ) yazı rengi beyaz olduğu için.

Bu hücreler dolu olduğu için başka formüllere ( düşeyara, topla.çarpım vb ) referans veriyorum, bu nedenle hücrelerin dolu olmasını arzuluyorum,

Tekrar teşekkür ederim.

 

[dEdE]

Spoyler: Buyurun

Sub Test()
t1 = [B1]
gün = [D1] - t1 + 1
sat = 3
ss = Cells(Rows.Count, "B").End(3).Row + 1
Application.ScreenUpdating = False
Range("A3:H" & ss + [A1]).Delete Shift:=xlUp

For j = 1 To gün
For i = 3 To [A1] + 2
Cells(sat, 1) = Format(t1, "dddd")
Cells(sat, 2) = t1
sat = sat + 1
Next i
t1 = t1 + 1
Next j

ss1 = Cells(Rows.Count, "B").End(3).Row
For k = 3 To ss1 Step [A1]
With Range("A" & k & ":H" & k - 1 + [A1])
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
Next k

For C = 3 To ss1 Step [A1]
Range(Cells(C, 1), Cells(C, 2)).Font.Color = vbRed
Range(Cells(C + 1, 1), Cells(C + [A1] - 1, 2)).Font.Color = vbWhite
Next C

For m = 1 To 7
Range(Cells(2, m), Cells(ss1, m)).Borders(xlEdgeRight).Weight = xlThin
Next m
Application.ScreenUpdating = False
End Sub

 

[1Al2Ver]

Sayın dEdE tekrar merhaba,

Emekleriniz ve nezaketiniz için çok teşekkür ederim, sağ olun.

Sevgi ve saygılarımla.

 

[1Al2Ver]

Merhaba,

Makro,

Range("A3:H99" & ss + [A1]).Delete Shift:=xlUp
ile tarih seçimine göre satırları aşağı-yukarı ayarlıyor, ancak kalması gereken "C3:H99" arasındaki verileri de siliyor.

İsteğim, "C3:H99" aralığının silinmemesi,

Olabiliyor ise "A3:B99" arasını da Calibri 9 yapmak yada kullanıcının seçimine bırakmak, istiyorum,
Kod'da gerekli düzenlemeyi rica ediyorum.

Teşekkür ederim.

 

[1Al2Ver]

Merhaba,

Çözümü beklemekteyim,

Teşekkür ederim.

 

[ahmed_ummu]

Merhaba,

Çözümü beklemekteyim,

Teşekkür ederim.

 

[1Al2Ver]

Sayın ahmed_ummu merhaba,

İlginiz için teşekkür ederim,

Font tamam, yalnız tarih değişimlerinde "Range("A3:b99" & ss + [A1]).Delete Shift:=xlUp" satırı "A3:B99" u silerken, örneğin tarihi 01.11.2022-30.11.2022 yaptığımızda 01.12.2022-31.12.2022' den kalan son satır (A:H sütununda 63 ve 64) da silinmeli,

28 (yada 29), 30 ve 31 çeken aylarda, satırlar bu ayların satırı kadar olmalı,

Örnek dosyada, başlangıç ve bitiş tarihi 28 gün olan Şubat ayı ile örneklendirilmiştir.

NOT: Tabloda, satır sayısı bazen 99 olabilmektedir.

Teşekkür ederim.