AW: Zellen anhand einer Vorauswahl sperren
15.03.2021 08:47:55
Yal
Hallo Benny,
es geht nicht um Pergormance (lustiger Vertipper. I like), sondern zuerst um Lesbarkeit des Codings: was wird man verstehen, wenn man nach 2 Monaten den Code wieder lesen muss? Oder jemand anderen lesen muss?
(Kommentar immer nach dem Code-Block)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("E2:P5000")) Is Nothing Then
sortieren_datum
CheckStatus (Target.Row)
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Position As Integer
Static ZelleDavor As Range
On Error GoTo Catch
Try:
If ZelleDavor.Column = 3 And ZelleDavor.Row >= 2 Then
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="test"
Position = ZelleDavor.Row
Call Zellen_sperren(ZelleDavor, Position)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=" _
test"
Application.EnableEvents = True
End If
Catch:
Finally:
Set ZelleDavor = Target
End Sub
Sub Zellen_sperren(Zelle, Position)
Dim List, i
Select Case Zelle.Value
Case "": List = "2222222222222"
Case "Neueröffnung": List = "0000001111000"
Case "Inhaberwechsel": List = "0000000000000"
Case "Umfirmierung": List = "0000000000000"
Case "Schließung": List = "0011110000111"
Case "weitere TID": List = "0000001111111"
Case "TID Abfrage": List = "0011001111111"
Case "KK Auftrag": List = "0011111111000"
'case "xy": list = "..." '0:offen, 1:gesperrt
Case Else: List = "0000000000000"
End Select
For i = 1 To Len(List)
Select Case Mid(List, i, 1)
Case 0
If Zelle.Offset(0, i).Value = "" Then blnReady = False
Zelle.Offset(0, i).Locked = False
Zelle.Offset(0, i).Interior.ColorIndex = 35
Case 1
Zelle.Offset(0, i).Locked = True
Zelle.Offset(0, i).Interior.ColorIndex = 22
Case Else
Zelle.Offset(0, i).Locked = True
Zelle.Offset(0, i).Interior.ColorIndex = False
End Select
Next
End Sub
In diesem Bereich nichts geändert. Nur die Lesbarkeit der 3 Fälle 0,1,2 (=Else)
Sub CheckStatus(Zeilennummer)
Dim Zelle As Range
Dim Status As Integer
' wenn eine der Pflicht-Zelle (= nicht gespert), dann "offen"
For Each Zelle In Range("F" & Zellennummer & ":P" & Zellennummer).Cells
If Not Zelle.Locked Then Status = Status - CInt(Zelle.Value = "")
Next Zelle
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="test"
Range("R" & Zeilennummer).Value = IIf(Status > 0, "offen", "erledigt")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test"
Application.EnableEvents = True
End Sub
Ensperren/sperren beschränkt auf das nötigste (kein muss).
Da der Test am Ende nur noch als ja oder nein ausgewertet wird, besteht nicht den Bedarf einen Array an Ja/Nein zu sammeln (die muss Du noch üben ;-)
CInt (...boolsche Test...) liefert -1 bei True sonst null. Daher - CInt(...), um den Status hoch zu zählen. Ab Status > 0 ist es offen.
Sub sortieren_datum()
Dim letzte_zeile As Long
ActiveSheet.Unprotect Password:="test"
letzte_zeile = .Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:R" & letzte_zeile).Sort Key1:=Range("E2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect Password:="test"
End Sub
Das Sortieren ist sauber. Nichts zu "verbessern".
VG
Yal