Question

我正在尝试制作一个可供员工预先预订假期的用户表单，以尽量减少重叠假期请求。

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

以下是我设法废弃的内容，但是当我调试错误时，＆＃34; For without next＆＃34; - 所以我试着把＃34; Next i＆＃34;在第71行然后错误出现为＆＃34;接下来没有阻止＆＃34; ：（

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

Answer 1

我想建议你使用数据库，因为用户可以在特定时期的不同日期申请。

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

如果您正在使用数据库，那么您可以更轻松地使用数据并放置条件

VBA + MS访问将起到作用

在日期范围之间进行重新审核并找出每个日期

1 个答案: