nöbet listesi

[tevfikseremet]

dosyamda nöbet sayısına göre (örnek tablodaki gibi) hemşirelere nöbet atamak istiyorum?

 

[halit3]

dosyamda nöbet sayısına göre (örnek tablodaki gibi) hemşirelere nöbet atamak istiyorum?

kod 1.

Private Sub CommandButton1_Click()
Dim x, s, i, deg, sat
Application.ScreenUpdating = False
deg = ""
sat = 4
i = 1
Set s = CreateObject("Scripting.Dictionary")
For Each x In Range("e3:ah33")
If x.Value <> "" Then
If Not s.exists(Trim(x.Value)) Then
s.Add Trim(x.Value), Nothing
If Cells(sat, 2).Value > 0 Then
If i = 1 Then
deg = x.Value
Else
deg = deg & "_" & x.Value
End If
If Val(Cells(sat, 2).Value) <= i Then
Cells(sat, 3).Value = deg
sat = sat + 1
deg = ""
i = 0
End If
Else
sat = sat + 1
deg = x.Value
i = 1
End If
i = i + 1
End If
End If
Next x
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub

kod 2

Private Sub CommandButton1_Click()
Dim x, r, s, i, say, deg, sat
Application.ScreenUpdating = False
deg = ""
sat = 4
i = 0
Set s = CreateObject("Scripting.Dictionary")
For Each x In Range("e3:ah33")
If x.Value <> "" Then
If Not s.exists(Trim(x.Value)) Then
s.Add Trim(x.Value), Nothing
i = i + 1
If i = 1 Then
deg = x.Value
Else
deg = deg & "_" & x.Value
End If
If Cells(sat, 2).Value = i Then
Cells(sat, 3).Value = deg
sat = sat + 1
deg = ""
i = 0
End If
End If
End If
Next x
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub

 

[tevfikseremet]

üstadım tam istediğim gibi olmuş tşk.

 

[halit3]

üstadım tam istediğim gibi olmuş tşk.

iyi çalışmalar