学习VBA变量

Question

我希望你们都很好，并且有一个愉快的假期。

我想知道是否有人可以帮助我。我想知道如何在下面的代码中添加一个新的变量，用于假期请求​​表单。

基本上，当用户请求的节日它复制他们的要求，他们的团队日历和提供的日期是可用的，那么下面的日期出现的术语“预订”

目前此项设定为2人关闭所有球队但是我想知道如何输入一个变量来改变这个错误每队

这样，如果队伍X被输入到工作表1范围A1允许2个人关闭，并且如果输入队伍Y工作表1范围A1允许1 off off

Dim Name As String, Team As String, StartRng As String, EndRng As String, ShiftRng As String, Final As String 
Dim LastRow As Long 
Dim Rng As Range, Rng2 As Range, cRange As Range, Cell As Range 

Team = Sheets("Request Form").Range("B11").Value 
Name = Team & Replace(Sheets("Request Form").Range("B7").Value, " ", "") 
LastRow = Sheets(Team).Cells(Rows.Count, "A").End(xlUp).Row 

If Sheets("Request Form").Range("B21").Value = Sheets("Request Form").Range("C21").Value Then 

    StartRng = Left(Sheets("Request Form").Range("B21").Value, 2) & Mid(Sheets("Request Form").Range("B21").Value, 4, 2) & Right(Sheets("Request Form").Range("B21").Value, 2) 
    If Sheets("Request Form").Range("D21").Value <> "" Then 
     ShiftRng = Sheets("Request Form").Range("D21").Value 
    Else 
     ShiftRng = "Full" 
    End If 
    Final = Team & StartRng & ShiftRng 
    Set Rng = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final)) 

    If Application.WorksheetFunction.CountA(Sheets(Team).Range(Sheets(Team).Cells(3, Rng.Column), Sheets(Team).Cells(LastRow, Rng.Column))) < 2 Then 
     Rng.Interior.ColorIndex = 6 
     Rng.Value = "BOOKED" 
     Rng.Font.Bold = True 
     Else 
     Range("DateRequest").Select 
     Selection.ClearContents 
     MsgBox " Not Booked" 
    End If 

Else 

    StartRng = Left(Sheets("Request Form").Range("B21").Value, 2) & Mid(Sheets("Request Form").Range("B21").Value, 4, 2) & Right(Sheets("Request Form").Range("B21").Value, 2) 
    EndRng = Left(Sheets("Request Form").Range("C21").Value, 2) & Mid(Sheets("Request Form").Range("C21").Value, 4, 2) & Right(Sheets("Request Form").Range("C21").Value, 2) 
    ShiftRng = "Full" 
    Final = Team & StartRng & ShiftRng 
    Set Rng = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final)) 
    Final = Team & EndRng & ShiftRng 
    Set Rng2 = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final)) 
    Set cRange = Sheets(Team).Range(Rng, Rng2) 
    For Each Cell In cRange 
     If Application.WorksheetFunction.CountA(Sheets(Team).Range(Sheets(Team).Cells(3, Cell.Column), Sheets(Team).Cells(LastRow, Cell.Column))) < 2 Then 
      Cell.Interior.ColorIndex = 6 
      Cell.Value = "BOOKED" 
      Cell.Font.Bold = True 
      If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "AM ") Then 
      bookedstring = bookedstring & (Sheets("CS").Cells(1, Cell.Column).Text & " (AM) Booked" & vbCr) 
      Else 
      If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "PM") Then 
      bookedstring = bookedstring & (Sheets("CS").Cells(1, (Cell.Column - 1)).Text & " (PM) Booked" & vbCr) 
      End If 
      End If 
      Else 
     Range("DateRequest").Select 
     Selection.ClearContents 
     If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "AM ") Then 
      bookedstring = bookedstring & (Sheets("CS").Cells(1, Cell.Column).Text & " (AM) Not Booked" & vbCr) 
      Else 
      If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "PM") Then 
      bookedstring = bookedstring & (Sheets("CS").Cells(1, (Cell.Column - 1)).Text & " (PM) Not Booked" & vbCr) 
      End If 
      End If 
     End If 
    Next Cell 
    MsgBox bookedstring 

    DateCopy.DateCopy 

End If 

任何帮助将不胜感激，请提出任何问题:)

Answer 1

我正在考虑沿这些线路的东西。然后用TeamName替换你的硬编码的2。

Dim TeamName as Long 

If sheet1.range("A1")="Team X" then 
    TeamName=2 
Else 
    TeamName=1 
End if 

替代方法

Select Case sheet1.range("A1").Value 
    case "Team X" 
     TeamName=2 
    case else 
     TeamName=1 
End Select