• DİKKAT

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

TARİH RENKLENDİRME

  • Konbuyu başlatan Konbuyu başlatan bkk
  • Başlangıç tarihi Başlangıç tarihi

bkk

Katılım
30 Aralık 2019
Mesajlar
186
Excel Vers. ve Dili
Ofis 2019
Merhabalar,
Örnek dosyada iki sayfam bulunmaktadır.
Bu sayfalardan ilkinde kişinin adı soyadı-konaklama gün sayısı-konaklama giriş tarihi bulunmakta, bu bilgilere istinaden ikinci sayfayı renklendirmek istiyorum, konu hakkında yardımcı olabilir misiniz, teşekkür ederim
 

Ekli dosyalar

.

Biraz daha izaha gerek var.
Eşleştirmeler nasıl yapılacak vs ayrıntılar verilmemiş.

.
 
Emir bey, mesela ben 1.10.2022 tarihinde 2 günlük geldim, ikinci tablomda o tarihte rastgele boş odayı benim için sarı yapsın istiyorum. sonrasında ben ikinci tabloya baktığımda sar hücrelerin dolu odayı ifade ettiğini anlayabilmek istiyorum
 
.

Test edebilir misiniz. Yerleştirdiği odalara X yazar.
Doğru çalıştığını teyit edelim. Boyama vs biçimlendirme işlemlerini yine yaparız.

Kod:
Sub kod()

Dim sk As Worksheet: Set sk = Sheets("KAYIT")
Dim s1 As Worksheet: Set s1 = Sheets("Sayfa1")


For a = 4 To sk.Cells(Rows.Count, "A").End(3).Row
kontrol = 0

g = sk.Cells(a, "D")
tg = Format(sk.Cells(a, "E"), "d") * 1

For b = 4 To s1.Cells(Rows.Count, "A").End(3).Row

If s1.Cells(b, tg + 4) = "" Then

For c = (tg + 4) To (tg + 4) + (g - 1)

If s1.Cells(b, c) = "" Then
'MsgBox s1.Cells(b, c).Address
Else
'MsgBox "Dolu"
GoTo digerodayagec
End If


Next c

kontrol = 1
s1.Range(s1.Cells(b, (tg + 4)), s1.Cells(b, c - 1)) = "X"
GoTo tamamlandı

End If

digerodayagec:
Next b


If kontrol = 0 Then
MsgBox sk.Cells(a, "B") & " sat:" & a & Chr(10) & " yerleşemedi"
End If

tamamlandı:
Next a

End Sub

.
 
Şu anda çalışıyor görünüyor çok teşekkür ederim koşullu biçimlendirme sağlayacağım, tekrar teşekkür ederim
 
Geri
Üst