Excel 重复日期范围，找出每个日期

我正在尝试制作一个用户表单，员工可以使用该表单提前预订假期，以最大限度地减少重复的假期请求

基本上现在我计划从输入的开始日期和结束日期生成一个日期列表，然后循环数组，逐个搜索日期

这是我设法拼凑起来的东西，但当我调试时，错误将是“没有下一个” -因此，我试图在第71行输入“Next I”，但随后错误显示为“Next without for block”：(

2） 我想锁定所有日历表（1-12月）。阅读有关使用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

Private子命令按钮2\u单击（）
我想我会坚持多久
Dim标准日期、enddate、rngedate作为日期
变暗rCell As范围
我的头发和头发一样长
将ws设置为工作表
日期
作为整数的Dim x
变暗范围
最后一排一样长
strdate=Me.tbDtF.Value
enddate=Me.tbDtT.Value
如果strdate=“False”则退出子项“已取消”
标准日期=格式（标准日期，“短日期”）
出错时继续下一步
如果enddate-strdate 0，则“根据缓冲区工作表条目生成日期列表”
ws=此工作簿。工作表（“缓冲区”）
与ws
lastrow=.Cells（.Rows.Count，1）.endxlup.Row
以
ws.Range（“A1”）.值=标准日期
ws.Range（“B1”）。值=结束日期
放线量=放线量范围（“A1”）
ColIndex=0
对于i=截止日期的标准日期
输出偏移量（ColIndex，0）=i
ColIndex=ColIndex+1
下一个
'循环所有日期以查找
对于i=1到最后一行
rngedate=范围（“A”&i）.值
'如果ws.Name=“LIST”则退出Sub'以仅在日历表中查找日期
设置rCell=Worksheets（UCase（Format（strdate，mmm）））.Cells.Find（What:=CDate（rngedate），After:=Range（“A1”），LookIn:=xlFormulas，LookAt:=xlWhole，SearchOrder:=xlByRows，SearchDirection:=xlNext，MatchCase:=False）
如果不是，那么rCell什么都不是
rCell.Offset（1，0）。Value=rCell.Offset（1，0）。Value+1'将值1添加到查找日期下方的单元格中
rCell.Offset（2,0）.Value=rCell.Offset（2,0）.Value+“”+Me.tbUser.Value”将用户名添加到单元格中
如果rCell.Offset（1，0）值小于6，则ppl每天休假的限制为5
使用ThisWorkbook.Worksheets（“列表”）将用户表单条目发送到工作表“列表”
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.tbrements.Value
以
MsgBox“您的假期预订已提交”
其他：MsgBox“对不起，申请请假的人数最多在”&rCell&“该日期”
如果结束
如果结束
如果enddate-strdate=0，则
设置rCell=Worksheets（UCase（Format（strdate，mmm）））.Cells.Find（What:=CDate（rngedate），After:=Range（“A1”），LookIn:=xlFormulas，LookAt:=xlWhole，SearchOrder:=xlByRows，SearchDirection:=xlNext，MatchCase:=False）
如果不是，那么rCell什么都不是
“MsgBox”位于“&rngX.Address”
如果rCell.Offset（1，0）值小于6，则ppl每天休假的限制为5
使用ThisWorkbook.Worksheets（“列表”）将用户表单条目发送到工作表“列表”
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.tbrements.Value
以
rCell.Offset（1，0）。Value=rCell.Offset（1，0）。Value+1'将值1添加到查找日期下方的单元格中
rCell.Offset（2,0）.Value=rCell.Offset（2,0）.Value+“”+Me.tbUser.Value”将用户名添加到单元格中
MsgBox“您的假期预订已提交”
其他：MsgBox“对不起，申请请假的人数最多在”&rCell&“该日期”
如果结束
如果结束
如果结束
错误转到0
如果rCell什么都不是
lReply=MsgBox（“找不到日期。请重试”，vbYesNo）
如果lReply=vbYes，则UserForm1.tbDtF.SetFocus
如果lReply=vbNo，则UserForm1.Hide
如果结束
端接头

我想给你的建议是，你可以使用数据库来实现这一点，因为用户可以在不同的日期申请特定的时间段

这将为您提供更多以前记录的选项，编辑假日计划等

如果您使用的是数据库，那么您可以更轻松地处理数据和设置条件

---

VBA+MS access将发挥作用

在发布长代码块时，请使用缩进。这对我们和您来说都更容易阅读代码。