yokuşahmet
Altın Üye
- Katılım
- 6 Ekim 2017
- Mesajlar
- 4
- Excel Vers. ve Dili
- türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
Merhaba
Alternatif bir çözüm Ek 'tedir.
Hayırlı Çalışmalar Dilerim.
![]()
Ekran Resmi 1
Ekli dosyayı görüntüle 239591
Ekran Resmi 2
Ekli dosyayı görüntüle 239593
Makrolar çalışmıyor bişey yapmam mı gerekiyor acaba