Toplantı Odaları Randevu/Rezervasyon

yokuşahmet

Altın Üye
Katılım
6 Ekim 2017
Mesajlar
4
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
10-10-2028
Arkadaşlar Merhaba
Ekli dosyada her sayfada farklı toplantı odalarımıza ait tablo bulunmakta son sayfada genel bir icmal gibi anlık durumu yani "BOŞ" yada "DOLU" belirtecek bir çözüm var mı?
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Deneyiniz.
Kod:
Sub DikdörtgenKöşeleriYuvarlatılmış1_Tıkla()

    Dim i As Byte, c As Range, k As Range, S1 As Worksheet, ss1 As Date, ss2 As Date, d As Byte
   
    [C5] = "=NOW()"
    For i = 2 To 10 Step 2
        Set S1 = Sheets(WorksheetFunction.Trim(Cells(8, i)))
        Set c = S1.[B:D].Find([C4], LookIn:=xlFormulas, LookAt:=xlWhole)
        If Not c Is Nothing Then
            d = 0
            If Minute([C5]) >= 30 Then d = 30
            ss1 = TimeSerial(Hour([C5]), d, 0)
            ss2 = TimeSerial(Hour([C5]) + 1, d, 0)
            Set k = S1.Cells(c.Row + 2, "B").Resize(21, 1).Find(ss1, LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not k Is Nothing Then
                If S1.Cells(k.Row, "C") = "" Then
                    Cells(9, i) = "BOŞ"
                Else
                    Cells(9, i) = "DOLU"
                End If
            End If
            Set k = S1.Cells(c.Row + 2, "B").Resize(21, 1).Find(ss2, LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not k Is Nothing Then
                If S1.Cells(k.Row, "C") = "" Then
                    Cells(11, i) = "BOŞ"
                Else
                    Cells(11, i) = "DOLU"
                End If
            End If
        End If
    Next i
   
End Sub
 

yokuşahmet

Altın Üye
Katılım
6 Ekim 2017
Mesajlar
4
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
10-10-2028
Ömer Bey ve Kulömer Beyler teşekkür ederim.
 

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Makrolar çalışmıyor bişey yapmam mı gerekiyor acaba
Merhaba

Program bende düzgün çalışıyor.

Sizdeki sorun ne olabilir bilemedim.

Bilgisayarınızın Makro Ayarlarını kontrol etmeniz faydalı olabilir.

Selamlar...
 
Üst