AW: Teste mal
08.08.2016 11:45:40
baschti007
Hey Ho einfach mal ersetzen
Gruß Basti
Private Sub CommandButton1_Click()
Dim datArea, findDate, setValue, matchDate, out, fillArea
Dim rngFound As Range
findDate = [B4].Text
setValue = [C4].Value
Const startCol = 6
Const startRow = 4
If (Format(findDate, "DDD") = "Sa" Or Format(CDate(findDate), "DDD") = "So") Then GoTo _
Error1
Set rngFound = ThisWorkbook.Worksheets("Feiertage").Columns("E:E").Find(What:=CDate( _
findDate), LookIn:=xlFormulas, LookAt:=xlWhole) ' LookIn:=xlFormulas oder LookIn:=xlValues
If Not rngFound Is Nothing Then GoTo Error2
Set datArea = Range(Cells(startRow, startCol).Address).Resize(, Cells(startRow, Columns. _
Count).End(xlToLeft).Column - startCol + 1)
out = Application.Transpose(Application.Transpose(datArea.Value))
matchDate = Application.Match(findDate, out, 0)
If IsNumeric(matchDate) Then
On Error Resume Next
Set fillArea = datArea.Cells(1, matchDate).Resize(300 - startRow, 1).SpecialCells(4)
If Err.Number = 1004 Then MsgBox " Der Bereich vom Datum " & findDate & " enthält keine _
leeren Zellen mehr", vbInformation: Exit Sub
fillArea.Value = setValue
Else
MsgBox "Datum " & findDate & " wurde nicht gefunden.", vbInformation
End If
Exit Sub
Error1:
MsgBox "Kann nicht am Wochenende ausgeführt werden"
Exit Sub
Error2:
MsgBox "Kann nicht an Feiertagen ausgeführt werden"
Exit Sub
End Sub