VBA Excel: Blattschutz Problem

Sy0v · Mai 9, 2014

Hallo Habo,

Ca. in der 25sten Zeile liegt das Problem. Bestimmte Benutzer dürfen nur eine 0 Eintragen und Sie auch löschen. Das mit der 0 Funktioniert auch so weit, nur das Problem liegt beim löschen von der Eingabe. Die Application.OnKey gibt mir die Fehlermeldung: Funktion oder Variable erwartet.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngFind As Range
Dim i As Integer

Dim user As String
Dim allow_u1 As String
Dim allow_u2 As String
Dim allow_u3 As String
Dim allow_u4 As String

allow_u1 = "a"
allow_u2 = "b"
allow_u3 = "c"
allow_u4 = "d"
user = Environ("username")

    Select Case user
        Case Is = allow_u1
        Case Is = allow_u2
        Case Is = allow_u3
        Case Is = allow_u4
        Case Else
            If Intersect(Target, Range("E4:AT185")) Is Nothing Then
            Else
                If Target.Text = 0 Or Application.OnKey("{CLEAR}") Then
                Else
                'Target.Delete'
                MsgBox ("Du hast keine Zugrifsberrechtigung")
                End If
            End If
    End Select
    Select Case Target.Column
        Case 3, 4
            With Sheets(2)
                Set rngFind = .Columns(1).Find(Target.Text)
                If Not rngFind Is Nothing Then
                    For i = 5 To 35
                        If .Cells(rngFind.Row, i) = "x" Then
                            If Sheets(1).Cells(Target.Row, i) <> "1" Then
                               Sheets(1).Cells(Target.Row, i) = "0"
                            End If
                        End If
                    Next
                End If
            End With
        Case Else
            Exit Sub
    End Select
End Sub

Ich kenne mich mit dieser Methode kaum aus und Google hat mir bis jetzt auch nicht Helfen können.
Habt Ihr vl. einen Denkanstoß oder eine bessere Idee dieses Problem zu lösen. Ich kann die Datei auch Hochladen wenn sie benötigt wird.

Mit freundlichen Grüßen
Sy0v

Sy0v · Mai 11, 2014

Habe das Problem gelöst.
Habe es ohnen abfangen der Entf Taste gemacht in dem ich einfach abgefragte habe ob es Leer oder null ist sonst...

Hier der jetztige Code

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngFind As Range
Dim i As Integer

Dim user As String
Dim allow_u1 As String
Dim allow_u2 As String
Dim allow_u3 As String
Dim allow_u4 As String

allow_u1 = "a"
allow_u2 = "b"
allow_u3 = "c"
allow_u4 = "d"
user = Environ("username")

    Select Case user
        Case Is = allow_u1
        Case Is = allow_u2
        Case Is = allow_u3
        Case Is = allow_u4
        Case Else
            If Intersect(Target, Range("E4:AT185")) Is Nothing Then
            Else
                If Target.Text = 0 [COLOR=Red]Or Target.Text = "" [/COLOR]Then
                Else
                Target.ClearContents
                MsgBox ("Du hast keine Zugrifsberrechtigung")
                End If
            End If
    End Select
    Select Case Target.Column
        Case 3, 4
            With Sheets(2)
                Set rngFind = .Columns(1).Find(Target.Text)
                If Not rngFind Is Nothing Then
                    For i = 5 To 35
                        If .Cells(rngFind.Row, i) = "x" Then
                            If Sheets(1).Cells(Target.Row, i) <> "1" Then
                               Sheets(1).Cells(Target.Row, i) = "0"
                            End If
                        End If
                    Next
                End If
            End With
        Case Else
            Exit Sub
    End Select
End Sub