change olayına kod ilave etmek

[ismailozkan4224]

değerli arkadaşlar aşağıdaki kodla işlem yapmaktayım. ancak şöyle bir ilave istiyorum.
(b4:cv50) arasındaki hücrelerde ;hücre içeriği boş ise hücrelerden 4. satır sarı,5. satır yeşil,6. satır sarı,7. satır yeşil........şeklinde 50. satıra kadar. eğer hücre içeriği dolu ise dolgu yok.

Private Sub Worksheet_Change(ByVal Target As Range) 'SAYFADA SİLMEYİ ENGELLEME
On Error GoTo son
If Intersect(Target, [C4:C50]) Is Nothing Then Exit Sub
Cells(Target.Row, "H:H") = Cells(1, 1)
Cells(Target.Row, "E:E") = Cells(1, 6) & " " & Cells(1, 9)
Cells(Target.Row, "d:d") = Cells(Target.Row, "B") & " " & Cells(Target.Row, "C")
Cells(Target.Row, "O:O") = Cells(1, 15)
Cells(Target.Row, "S:S") = Cells(1, 19)
Cells(Target.Row, "T:T") = Cells(1, 20)
Cells(Target.Row, "V:V") = Cells(1, 22)
Cells(Target.Row, "W:W") = Cells(1, 23)
Cells(Target.Row, "X:X") = Cells(1, 24)
Cells(Target.Row, "Y:Y") = Cells(1, 25)
Cells(Target.Row, "Z:Z") = Cells(1, 26)
Cells(Target.Row, "AA:AA") = Cells(1, 27)
Cells(Target.Row, "AB:AB") = Cells(1, 33)
Cells(Target.Row, "AC:AC") = Cells(1, 29) & " " & Cells(1, 30)
If Not Intersect(Target, [C4:C2000]) Is Nothing Then Cells(Target.Row, "AD") = Format(Now, "dd.mm.yyyy hh:mm")
son:
If Target.Column <> 3 Then Exit Sub ' OTOMATİK OLARAK B SÜTUNUNA VERİ GİRİLDİĞİNDE SIRA NUMARASI VERİR
If Target.Row = 2 Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "~" Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "~" Then Exit Sub
If Left(Target.Offset(0, -1), 1) = "=Row()-3" Then Exit Sub
Target.Offset(0, -2).Formula = "=Row()-3"
Application.EnableEvents = True
Target.Select
CommandButton21_Click

End Sub

 

[ismailozkan4224]

şöyle bir ilave uygulamaya çalıştım ama hata verdi.

For sut = 1 To 100
For sat = 4 To 50
For sat1 = 4 To 50 Step 2
For sat2 = 5 To 49 Step 2
If Cells(sat, sut) = "" Then Cells(sat, sut).Interior.Color = vbRed 'renksiz olacak
If Cells(sat, sat1) <> "" Then Cells(sat, sat1).Interior.Color = vbGreen
If Cells(sat, sat2) <> "" Then Cells(sat, sat2).Interior.Color = vbYellow
Next
Exit Sub

 

[turist]

Eklediğiniz dosya bozulmuş.

Koşullu Biçimlendirme ile istediğinizi yapabilirsiniz.
Koşullu biçimlendirme yapılacak alanı B4:CV50 seçin,
Üst menüden Koşullu Biçimlendirme/Yeni Biçimlendirme Kuralı / Biçimlendirilecek Hücreleri Belirlemek için Formül Kullan seçin,
Sırayla 3 defa Formül ve Renk belirleyin.
Koşullu Biçimlendirme için uygulanacak Formüller ve Renkler
1-) Formül =B4="" Renk: "Kırmızı"
2-) Formül =MOD(SATIR();2)=0 Renk: "Sarı"
3-) Formül =MOD(SATIR();2)=1 Renk: "Yeşil"
"Tamam" tuşuna basarak bitirin.

 

[ismailozkan4224]

dosyayı güncelledim. ancak makro ile yapmam lazım

 

[turist]

dosyayı güncelledim. ancak makro ile yapmam lazım

İyi çalışmalar.