AW: Jahresplanung
06.05.2012 16:55:12
hary
Hallo Ingo
Teste mal. Hab ich erstmal auf SpalteM erweitert. Richtiger Bereich muss noch erweitert werden.
In A2 bis A7 hast Du eine Liste, in der kannst Du die namen auswaehlen. Naach auswahl werden die freien Zellen markiert.
Wenn Du jetzt In den Wochenspalten einen Namen eintraegst gehts weiter. Teste mal mit Herbert.
Herbert auch in SpalteM eintragen.
einen Zähler(geht aautomatisch runter) hab ich in SpalteA vor den Namen.
https://www.herber.de/bbs/user/80061.xls
gruss hary
fuer Mitleser evtl gibt's eine bessere Loesung.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Variant
Dim i As Long
If Target.Count = 1 Then
If Target = "" Then Exit Sub
If Not Intersect(Range("A2:A7"), Target) Is Nothing Then
Cells(Target.Row, 3).Resize(1, 11).Interior.Color = xlNone
For i = 3 To 13
If Application.CountIf(Cells(2, i).Resize(6, 1), Target) > 0 And Cells(Target.Row, i) = _
"" Then
If Cells(Target.Row, i) = "" Then Cells(Target.Row, i).Interior.Color = vbRed
Else
If Cells(Target.Row, i) = "" Then Cells(Target.Row, i).Interior.Color = vbGreen
End If
Next
End If
If Not Intersect(Range("C2:M7"), Target) Is Nothing Then
If Application.CountIf(Cells(2, Target.Column).Resize(6, 1), Target) > 1 Then
MsgBox Target & " fährt schon"
Target = ""
Exit Sub
Else
a = Application.Match(Trim(Target), Range("B11:B17"), 0)
If IsNumeric(a) Then
If Cells(a + 10, 1) = 0 Then
MsgBox Target & " Anzahl überschritten"
Target = ""
Exit Sub
Else
Cells(a + 10, 1) = Cells(a + 10, 1) - 1
End If
End If
End If
End If
End If
End Sub