0
我正在尝试制作一个用户表单，供工作人员使用，以提前预订假日以尽量减少重叠的假期请求。复制日期范围和查找每个日期
基本上现在我打算从输入的开始日期和结束日期生成一个日期列表，然后循环查找数组，逐个搜索日期。
这是我管理报废在一起，但是当我调试的错误将是“对于没有下一步” - 所以我试图把“下一个我”，在71行，但随后的错误出来的“下一步而不为块“:(
2）我想锁定所有日历表（JAN-DEC）。阅读一些有关锁定和使用VBA解锁，但在我试用:(
我非常感谢所有点的学习和帮助，什么都没有发生。
非常感谢你
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
在发布的代码长块，请使用**缩进**。这对我们和您来说更容易阅读您的代码。 –