Macro döngüsünde boş yerin olmaması için ne yapmalıyım

[mersilen]

Merhabalar

macro ile nöbet programı yapmaya çalışıyorum
Programı buraya kadar getirdim
yalnız günleri isteğe göre doldururken arada boş yerler bırakıyor
bunun için döngüye nasıl müdahale edilebilir

çalışma mantığında tüm sütun boş olabilir ve isteğe göre aralara önceden atama yapılırsada boş yer bırakmamalı

şimdiden teşekkürler

 

[hassan26]

Selam
Q sütununda -/+3 gün sayımı yapar(kişi <1 )ise + yerine
1'den küçük veya eşit demende sakınca yoksa < = 1 yazarsan makro boşluk bırakmıyor.

(WorksheetFunction.CountIf(Range(Cells(x - 3, "Q"), Cells(x + 3, "Q")), kisi) < 1 And _ yerine
(WorksheetFunction.CountIf(Range(Cells(x - 3, "Q"), Cells(x + 3, "Q")), kisi) <= 1 And _

+3 -3 10 kişi var anladığım kadarıyla 30 a tamamlıyor 1 günü boş bırakıyor
örneğin = yerine A.B.C.D.E.F.G.H.I.J. K kişisi ekleyip döngüyü For ksu = 1 To 10 "kişi sütunu" yerine For ksu = 1 To 11 yapıncada makro boşluk bırakmıyor.
Kolay gelsin

 

[mersilen]

Merhabalar

Selam
+3 -3 10 kişi var anladığım kadarıyla 30 a tamamlıyor 1 günü boş bırakıyor
örneğin = yerine A.B.C.D.E.F.G.H.I.J. K kişisi ekleyip döngüyü For ksu = 1 To 10 "kişi sütunu" yerine For ksu = 1 To 11 yapıncada makro boşluk bırakmıyor.
Kolay gelsin

Sizin dediğiniz gibi yaparsam kişiler gün aşırı yazılıyor, tabloda k
işi sayısını artırıp , yeni şart ekleyerek tekrar yüklüyorum,
1--yalnız şartların olduğu yerde formül hata veriyor
2-- Yeni farkettim hata kontrol satırında ts değeri 15 oluyor,bunun olmaması lazım (çünkü for ts = 8 to 14 döngüsünde)

Uzman arkadaşlar bir değerlendirebilirler mi?

'Option Explicit
Private Sub CommandButton1_Click()
Dim x, ts As Integer
Dim gs, ksu As Integer
Dim hucre As Range
Application.ScreenUpdating = False
Application.Calculation = xlManual
For x = 5 To 35
If Cells(x, "AC") = "" Then

For ts = 8 To 14 ' gün satırı
If (Cells(ts, "V")) = Format(Cells(x, "AB"), "dddd") Then
Range("A22") = Clear: Range("A22") = "X=" & x & "; TS gün:" & ts - 7 & " " & Format((Cells(ts, "V")), "dddd")
gs = ts 'gün satırı
Else
End If
Next ts

For ksu = 1 To 20 'kişi sütunu
kisi = Cells(7, ksu)
kgn = 0 'kişinin gün satırında nöbeti
For Each hucre In Range("AB5:AB35")
If Format(hucre, "dddd") = (Cells(ts, "V")) And kisi = Cells(hucre.Row, "AC") Then
kgn = kgn + 1
Range("a23") = kgn
End If
Next
If Cells(x, "AC") = "" And _
Cells(gs, ksu) <> "" And Cells(gs, ksu) < kgn And _
(WorksheetFunction.CountIf(Range(Cells(x - 3, "AC"), Cells(x + 3, "AC")), kisi) < 1 And _
(WorksheetFunction.CountIf(Range("AC5:AC35"), kisi) < ((Cells(15, ksu).Value) - 0))) _
Then

Cells(x, "AC") = kisi
ElseIf Cells(x, "AC") = "" Then Cells(20 + x, ksu) = "hata x=" & x & " ts=" & ts & " ksu:" & ksu 'HATA KONTROL SATIRI
End If
'FORMÜLLERİN AMAÇLARI
'Cells(x, "AC") = "" And 'Cells(x, "AC"); doldurulacak yer boşsa
'Cells(gs, ksu) <> "" And 'Cells(gs, ksu); boş değilse , kişinin aynı gün nöbeti olacaksa
'Cells(gs, ksu) < kgn 'kgn -- Cells(gs, ksu) değeri (Range("AC5:AC35") dizesinde kendi gününden az ise
'CountIf(Range(Cells(x - 3, "AC"), Cells(x + 3, "AC")), kisi) < 1 And '-/+ 3 gün satırı, kişi sık nöbet tutmasın diye
'CountIf(Range("AC5:AC35"), kisi) < ((Cells(15, ksu).Value) - 0))) 'Kişinin nöbet sayısı toplam nöbetine erişmediyse
Next ksu

Else
End If
Next x
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub