VBA変数を学習する

Question

私はあなたがうまくいって、素晴らしいホリデーシーズンを過ごしたことを願っています。

誰かが私を助けることができるのだろうかと思っていました。私は休暇申請フォームに使用している下のコードに新しい変数を追加する方法を知りたいと思います。

ユーザーが自分のチームのカレンダーに休日のそれのコピーに彼らの要求を要求し、日付を提供することが、その後の日付の下に用意されてい基本的にはすべてのチームのために2人に

現在、これが設定されている「予約」という用語をオフに表示されます私は変数を入力して各チームをどのように変更できるかを知りたいです

チームXがシート1に入力されている場合、範囲A1は2人を許可し、チームYはシート1に入力します。人はオフ

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

私はこれらの行に沿って何かを考えていました。次に、ハードコード2をTeamNameに置き換えます。

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