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
在發佈的代碼長塊，請使用**縮進**。這對我們和您來說更容易閱讀您的代碼。 –