REITET ZWISCHEN DATE RANGE UND FINDEN JEDES DER DATEN

Question

Ich versuche, ein Benutzerformular, das von Mitarbeitern verwendet werden kann, um Urlaub im Voraus zu buchen, um überlappende Urlaub Anfrage zu minimieren.

Im Grunde plane ich jetzt, eine Liste von Daten vom eingegebenen Startdatum und Enddatum zu erstellen, dann im Array herumzulaufen und nacheinander nach den Daten zu suchen.

Hier ist, was ich zusammen zu verschrotten, aber wenn ich den Fehler debuggen würde "For ohne Next" - so habe ich versucht, "Next i" in Zeile 71, aber dann der Fehler herauskommen als "Next ohne für block ":(

2) Ich möchte alle Kalenderblätter sperren (JAN-DEC). Lesen Sie etwas über Sperren und Entsperren vba verwenden, aber es ist nichts passiert in meinem Prozeß :(

Ich schätze wirklich alle Punkte zu lernen und zu helfen.

danken Ihnen sehr viel

Private Sub CommandButton2_Click() 
Dim i As Long 
Dim strdate, enddate, rngedate As Date 
Dim rCell As Range 
Dim IReply As Long 
Dim ws As Worksheet 
Dim d As Date 
Dim x As Integer 
Dim OutRng As Range 
Dim lastrow As Long 

strdate = Me.tbDtF.Value 
enddate = Me.tbDtT.Value 
If strdate = "False" Then Exit Sub 'Cancelled 
strdate = Format(strdate, "Short Date") 
On Error Resume Next 
If enddate - strdate <> 0 Then 'generate list of date base on entry to buffer worksheet 
ws = ThisWorkbook.Worksheets("Buffer") 
With ws 
lastrow = .Cells(.Rows.Count, 1).endxlup.Row 
End With 
ws.Range("A1").Value = strdate 
ws.Range("B1").Value = enddate 
Set OutRng = OutRng.Range("A1") 

ColIndex = 0 
For i = strdate To enddate 
OutRng.Offset(ColIndex, 0) = i 
ColIndex = ColIndex + 1 
Next 

'looping all date to find 
For i = 1 To lastrow 
rngedate = Range("A" & i).Value 
' If ws.Name = "LIST" Then Exit Sub 'to look for date in calendar sheets only 
Set rCell = Worksheets(UCase(Format(strdate, "mmm"))).Cells.Find(What:=CDate(rngedate), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) 
If Not rCell Is Nothing Then 
rCell.Offset(1, 0).Value = rCell.Offset(1, 0).Value + 1 'adding value 1 to the cell below found date 
rCell.Offset(2, 0).Value = rCell.Offset(2, 0).Value + " " + Me.tbUser.Value 'adding the username to the cell 

If rCell.Offset(1, 0).Value < 6 Then 'limit for ppl on leave per day is 5 
With ThisWorkbook.Worksheets("LIST") 'sending userform entry into worksheet "list" 
i = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 
.Cells(i, 1).Value = Me.tbUser.Value 
.Cells(i, 2).Value = Me.tbDtF.Value 
.Cells(i, 3).Value = Me.tbDtT.Value 
.Cells(i, 5).Value = Me.tbRemarks.Value 
End With 

MsgBox "Your leave booking is submitted" 
Else: MsgBox "Sorry, maximum people have applied for leave on" & rCell & "that date" 
End If 


End If 
If enddate - strdate = 0 Then 
Set rCell = Worksheets(UCase(Format(strdate, "mmm"))).Cells.Find(What:=CDate(rngedate), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) 

If Not rCell Is Nothing Then 
'MsgBox "Found at " & rngX.Address 
If rCell.Offset(1, 0).Value < 6 Then 'limit for ppl on leave per day is 5 
With ThisWorkbook.Worksheets("LIST") 'sending userform entry into worksheet "list" 
i = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 
.Cells(i, 1).Value = Me.tbUser.Value 
.Cells(i, 2).Value = Me.tbDtF.Value 
.Cells(i, 3).Value = Me.tbDtT.Value 
.Cells(i, 5).Value = Me.tbRemarks.Value 
End With 
rCell.Offset(1, 0).Value = rCell.Offset(1, 0).Value + 1 'adding value 1 to the cell below found date 
rCell.Offset(2, 0).Value = rCell.Offset(2, 0).Value + " " + Me.tbUser.Value 'adding the username to the cell 
MsgBox "Your leave booking is submitted" 
Else: MsgBox "Sorry, maximum people have applied for leave on" & rCell & "that date" 
End If 
End If 
End If 
On Error GoTo 0 
If rCell Is Nothing Then 
lReply = MsgBox("Date cannot be found. Try Again", vbYesNo) 
If lReply = vbYes Then UserForm1.tbDtF.SetFocus 
If lReply = vbNo Then UserForm1.Hide 
End If 

End Sub 

Answer 1

Ich möchte geben, Ihr Vorschlag ist, dass Sie die Datenbank dafür verwenden, da Benutzer sich auf ein anderes Datum für einen bestimmten Zeitraum bewerben können

Dies wird Ihnen mehr Optionen von Vorherige Datensätze, Bearbeiten Sie den Urlaubsplaner, etc ...

Wenn Sie die Datenbank verwenden, dann können Sie mit den Daten spielen und Bedingungen stellen in viel einfacheren Weg

VBA + MS Zugang wird der Trick