ganiyu
Altın Üye
- Katılım
- 21 Aralık 2016
- Mesajlar
- 53
- Excel Vers. ve Dili
- Office Professional Plus 2019 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=VE(D$4>=DOLAYLI("GENEL!G"&KAÇINCI($B5;GENEL!$I:$I;0));D$4<=DOLAYLI("GENEL!H"&KAÇINCI($B5;GENEL!$I:$I;0)))
Sub Deneme()
Dim i As Long
Dim j As Long
Dim bsCol As Integer
Dim btCol As Integer
Dim c As Range
btCol = Sayfa2.Range("B4").End(xlToRight).Column
i = Sayfa2.Cells(Rows.Count, "B").End(3).Row
If i < 5 Then i = 5
Sayfa2.Range(Sayfa2.Cells(5, 4), Sayfa2.Cells(i, btCol)).Interior.Pattern = xlNone
For i = 5 To Sayfa1.Cells(Rows.Count, "B").End(3).Row
j = 0
On Error Resume Next
j = Application.WorksheetFunction.Match(Sayfa1.Range("I" & i), Sayfa2.Columns("B:B"), 0)
On Error GoTo 0
If j > 0 Then
bsCol = Sayfa1.Cells(i, "G") - Sayfa2.Range("D4") + 4
btCol = bsCol + Sayfa1.Cells(i, "H") - Sayfa1.Cells(i, "G")
Sayfa2.Range(Sayfa2.Cells(j, bsCol), Sayfa2.Cells(j, btCol)).Interior.ColorIndex = bsCol
End If
Next i
End Sub
Çok teşekkür ederim.Tekrar merhaba,
Makro olarak isterseniz aşağıdaki kodları deneyiniz.
Kod:Sub Deneme() Dim i As Long Dim j As Long Dim bsCol As Integer Dim btCol As Integer Dim c As Range btCol = Sayfa2.Range("B4").End(xlToRight).Column i = Sayfa2.Cells(Rows.Count, "B").End(3).Row If i < 5 Then i = 5 Sayfa2.Range(Sayfa2.Cells(5, 4), Sayfa2.Cells(i, btCol)).Interior.Pattern = xlNone For i = 5 To Sayfa1.Cells(Rows.Count, "B").End(3).Row j = 0 On Error Resume Next j = Application.WorksheetFunction.Match(Sayfa1.Range("I" & i), Sayfa2.Columns("B:B"), 0) On Error GoTo 0 If j > 0 Then bsCol = Sayfa1.Cells(i, "G") - Sayfa2.Range("D4") + 4 btCol = bsCol + Sayfa1.Cells(i, "H") - Sayfa1.Cells(i, "G") Sayfa2.Range(Sayfa2.Cells(j, bsCol), Sayfa2.Cells(j, btCol)).Interior.ColorIndex = bsCol End If Next i End Sub
Not : Kodlarda geçen Sayfa1 ve Sayfa2, sayfa indisleridir. Sheets("GENEL") yerine Sayfa1, Sheets("HAZIRAN") yerine de Sayfa2. kullandım.
@korhan Aydın bey çok teşekkür ederim. Elinize sağlık. Harika olmuş.Merhaba,
1 ay içinde aynı oda için 7 farklı konaklama tanımlayarak formülle çözüm ürettim. Aynı tarihlere gelen konaklamalar için uyarı amaçlı KIRMIZI dolgu rengi kullandım.
Formüller performans açısından 1000 satırlık veri için kurgulanmıştır.