- Katılım
- 16 Eylül 2008
- Mesajlar
- 1,291
- Excel Vers. ve Dili
- Microsoft Office 2019 English
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub test()
Dim Bak As Long
Dim Kln As Integer
Dim xSay As Byte
For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
For Kln = 4 To Cells(Bak, Columns.Count).End(xlToLeft).Column
If Cells(Bak, Kln) = "X" Then
xSay = xSay + 1
If xSay = 5 And (Cells(Bak, Kln + 1) = "X" Or Cells(Bak, Kln + 1) = "") Then
Cells(Bak, Kln).Interior.Color = 255
xSay = 0
End If
Else
xSay = 0
End If
Next
xSay = 0
Next
End Sub