Aktuell kann es Probleme bei der Anmeldung mit dem Chrome oder Edge Browser geben. Ihr müsstet in die Einstellungen des Browsers gehen und Cache, Cookies und sofern vorhanden, gespeicherte Passwörter vom CEF löschen oder alternativ auf einen anderen Browser ausweichen. Ursache sind vermutlich kürzliche Browserupdates. x
Clever-Excel-Forum › Office-Anwendungen › Excel v
Löschfunktion ??

Thema geschlossen 
Baumstrukturmodus
Löschfunktion ??
Fredl55 Offline
Benutzer
Registriert seit: 16.10.2014
Version(en): 2013
#1
14.12.2015, 08:00
Guten morgen zusammen,
kaum hat sich ein Thema erledigt, schon steh ich vor dem nächsten Problem. Ich habe eine Tabelle mit den Spalten A - D und Zeilen 1-20. In jeder Zelle ist die gleiche Gültigkeit hinterlegt. Hier können sich Mitarbeiter mit Namenskürzeln eintragen, die zu einer bestimmten Zeit Arbeiten wollen. Gibt es eine Möglichkeit, dass sich die Mitarbeiter zwar eintragen können, jedoch nicht löschen können. Es kommt immer wieder vor, dass andere durch den Eintrag gelöscht werden.
Hätte da jemand eine Lösung ?

Gruß Fred
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#2
14.12.2015, 08:20
Hallo Fred,

folgender Code kommt in das schon vorhandene VBA-Modul des entsprechenden Tabellenblattes:

----------------------------------------------------------------------------
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim varEintrag As Variant
 If Not Application.Intersect(Range("A1:D20"), Target) Is Nothing Then
   On Error Resume Next
   Application.EnableEvents = False
   If Target.Count > 1 Then
     Application.Undo
   Else
     varEintrag = Target.Value
     Application.Undo
     If IsEmpty(Target) Then
       Target.Value = varEintrag
     Else
       MsgBox "Eintag ist nur in einer leeren Zelle möglich!", vbCritical
     End If
     Application.EnableEvents = True
     On Error GoTo 0
   End If
 End If
End Sub

----------------------------------------------------------------------------
VBA/HTML - CodeConverter für Excelforen
AddIn für Excel 2002-2013 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch René Holtz (alias mumpel)
Code erstellt und getestet in Office 14
----------------------------------------------------------------------------

Die Datei muss dann aber mit der Endung .xlsm oder xlsb gespeichert werden.

Gruß Uwe
Suchen
Top
Fredl55 Offline
Benutzer
ThreadStarter

Registriert seit: 16.10.2014
Version(en): 2013
#3
15.12.2015, 03:58 (Dieser Beitrag wurde zuletzt bearbeitet: 15.12.2015, 09:25 von Rabe. Bearbeitungsgrund: Code durch 5. Button von rechts strukturiert dargestellt )
Hallo Uwe,

ich habe bereits folgenden Code drinnen und wenn ich deinen hinten an setze dann funktioniert das nicht. Was mach ich falsch?

Der Code, den ich bereits habe, ist:

Code:
 Const bolSorted As Boolean = True       ' Legt fest, ob die Werte noch sortiert werden.
 Dim blockedEvent As Boolean
 Dim TargetOldText As String

 Private Sub Worksheet_Change(ByVal Target As Range)
     Dim strResult As String
     Dim strTarget As String
     Dim arrSorted As Variant
     Dim i As Long
     If Target.Column = 13 Or Target.Column = 24 Then
         strTarget = Trim$(Target.Value)
         If Not blockedEvent Then
             blockedEvent = True
             If Not TargetOldText = "" And Not Target.Value = "" Then
                 If InStr(1, TargetOldText, Target.Value) > 0 Then
                     strResult = Replace(TargetOldText, ", " & strTarget, "")
                     strResult = Replace(strResult, strTarget & ", ", "")
                     strResult = Replace(strResult, strTarget, "")
                 Else
                     strResult = TargetOldText & ", " & Target.Value
                 End If
                 If bolSorted Then
                     arrSorted = Split(strResult, ", ")
                     strResult = ""
                     Call Selectionsort(arrSorted)
                     For i = 0 To UBound(arrSorted)
                         strResult = strResult & arrSorted(i) & ", "
                     Next i
                     If Len(strResult) > 1 Then _
                     strResult = Left$(strResult, Len(strResult) - 2)
                 End If
                 Target.Value = strResult
             Else
                 Target.Value = Target.Value
             End If
             TargetOldText = Target.Value
         Else
             blockedEvent = False
         End If
     Else
         TargetOldText = ""
     End If
 End Sub

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     On Error Resume Next
     If Target.Column = TargetColumn Then
         TargetOldText = Target.Value
     End If
 End Sub

 Private Sub Selectionsort(ByRef data As Variant)
     Dim OG&, i&, j&, k&, h As Variant
     OG = UBound(data)
     For i = 0 To OG - 1
         h = data(i)
         k = i
         For j = i + 1 To OG
             If data(j) < h Then
                 h = data(j)
                 k = j
             End If
         Next j
         data(k) = data(i)
         data(i) = h
     Next i
 End Sub

Wie bring ich jetzt deinen code noch mit unter?
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#4
15.12.2015, 08:31 (Dieser Beitrag wurde zuletzt bearbeitet: 15.12.2015, 08:31 von Kuwer.)
Hallo Fred,

so vielleicht:

Microsoft Excel Objekt Tabelle1
Option Explicit 

Const bolSorted As Boolean = True       ' Legt fest, ob die Werte noch sortiert werden. 
Dim blockedEvent As Boolean 
Dim TargetOldText As String 

Private Sub Worksheet_Change(ByVal Target As Range) 
 Dim varEintrag As Variant 
 Dim strResult As String 
 Dim strTarget As String 
 Dim arrSorted As Variant 
 Dim i As Long 
 If Not Application.Intersect(Range("A1:D20"), Target) Is Nothing Then 
   On Error Resume Next 
   Application.EnableEvents = False 
   If Target.Count > 1 Then 
     Application.Undo 
   Else 
     varEintrag = Target.Value 
     Application.Undo 
     If IsEmpty(Target) Then 
       Target.Value = varEintrag 
     Else 
       MsgBox "Eintag ist nur in einer leeren Zelle möglich!", vbCritical 
     End If 
     Application.EnableEvents = True 
     On Error GoTo 0 
   End If 
 End If 
 If Target.Column = 13 Or Target.Column = 24 Then 
     strTarget = Trim$(Target.Value) 
     If Not blockedEvent Then 
         blockedEvent = True 
         If Not TargetOldText = "" And Not Target.Value = "" Then 
             If InStr(1, TargetOldText, Target.Value) > 0 Then 
                 strResult = Replace(TargetOldText, ", " & strTarget, "") 
                 strResult = Replace(strResult, strTarget & ", ", "") 
                 strResult = Replace(strResult, strTarget, "") 
             Else 
                 strResult = TargetOldText & ", " & Target.Value 
             End If 
             If bolSorted Then 
                 arrSorted = Split(strResult, ", ") 
                 strResult = "" 
                 Call Selectionsort(arrSorted) 
                 For i = 0 To Ubound(arrSorted) 
                     strResult = strResult & arrSorted(i) & ", " 
                 Next i 
                 If Len(strResult) > 1 Then _
                 strResult = Left$(strResult, Len(strResult) - 2) 
             End If 
             Target.Value = strResult 
         Else 
             Target.Value = Target.Value 
         End If 
         TargetOldText = Target.Value 
     Else 
         blockedEvent = False 
     End If 
 Else 
     TargetOldText = "" 
 End If 
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
 TargetOldText = Target.Value 
End Sub 

Private Sub Selectionsort(ByRef data As Variant) 
    Dim OG&, i&, j&, k&, h As Variant 
    OG = Ubound(data) 
    For i = 0 To OG - 1 
        h = data(i) 
        k = i 
        For j = i + 1 To OG 
            If data(j) < h Then 
                h = data(j) 
                k = j 
            End If 
        Next j 
        data(k) = data(i) 
        data(i) = h 
    Next i 
End Sub



Gruß Uwe
Suchen
Top
Fredl55 Offline
Benutzer
ThreadStarter

Registriert seit: 16.10.2014
Version(en): 2013
#5
17.12.2015, 15:08
Hallo Uwe,
die Formel passt hervorragend aber jetzt hab ich das Problem das ich einen Eintrag der aus versehen eingetragen worden ist nicht löschen kann. Gäbe es noch eine Version wo es eine Möglichkeit gibt dass hier der Eintrag evtl. über Passwort gelöscht werden kann ??

Gruß Fred
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#6
17.12.2015, 20:34 (Dieser Beitrag wurde zuletzt bearbeitet: 17.12.2015, 20:34 von Kuwer.)
Hallo Fred,

teste mal so:

Option Explicit

Const bolSorted As Boolean = True       ' Legt fest, ob die Werte noch sortiert werden.
Dim blockedEvent As Boolean
Dim TargetOldText As String

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim varEintrag As Variant
 Dim strResult As String
 Dim strTarget As String
 Dim arrSorted As Variant
 Dim i As Long
 If Not Application.Intersect(Range("A1:D20"), Target) Is Nothing Then
   On Error Resume Next
   Application.EnableEvents = False
   If Target.Count > 1 Then
     Application.Undo
   Else
     If IsEmpty(Target) Then
       varEintrag = InputBox("Bitte das Löschen mit Kennwort bestätigen!") = "Passwort"
     End If
     If Not varEintrag Then
       varEintrag = Target.Value
       Application.Undo
       If IsEmpty(Target) Then
         Target.Value = varEintrag
       Else
         MsgBox "Eintag ist nur in einer leeren Zelle möglich!", vbCritical
       End If
     End If
   End If
   Application.EnableEvents = True
   On Error GoTo 0
 End If
 If Target.Column = 13 Or Target.Column = 24 Then
     strTarget = Trim$(Target.Value)
     If Not blockedEvent Then
         blockedEvent = True
         If Not TargetOldText = "" And Not Target.Value = "" Then
             If InStr(1, TargetOldText, Target.Value) > 0 Then
                 strResult = Replace(TargetOldText, ", " & strTarget, "")
                 strResult = Replace(strResult, strTarget & ", ", "")
                 strResult = Replace(strResult, strTarget, "")
             Else
                 strResult = TargetOldText & ", " & Target.Value
             End If
             If bolSorted Then
                 arrSorted = Split(strResult, ", ")
                 strResult = ""
                 Call Selectionsort(arrSorted)
                 For i = 0 To UBound(arrSorted)
                     strResult = strResult & arrSorted(i) & ", "
                 Next i
                 If Len(strResult) > 1 Then _
                 strResult = Left$(strResult, Len(strResult) - 2)
             End If
             Target.Value = strResult
         Else
             Target.Value = Target.Value
         End If
         TargetOldText = Target.Value
     Else
         blockedEvent = False
     End If
 Else
     TargetOldText = ""
 End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
TargetOldText = Target.Value
End Sub

Private Sub Selectionsort(ByRef data As Variant)
   Dim OG&, i&, j&, k&, h As Variant
   OG = UBound(data)
   For i = 0 To OG - 1
       h = data(i)
       k = i
       For j = i + 1 To OG
           If data(j) < h Then
               h = data(j)
               k = j
           End If
       Next j
       data(k) = data(i)
       data(i) = h
   Next i
End Sub


Gruß Uwe
Suchen
Top
Fredl55 Offline
Benutzer
ThreadStarter

Registriert seit: 16.10.2014
Version(en): 2013
#7
17.12.2015, 22:25
Hallo Uwe,
erstmal vielen Dank das passt ganz klasse nur wie komm ich an das Kennwort bzw. wo geb ich das ein.
wie sähe denn der Code aus wenn es noch einen Zweiten seperaten Bereich E1-F20 geben würde für den die selben Regeln gelten würden.

Gruß Fred
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#8
17.12.2015, 23:17
Hallo Fred,

ändere die Zeile

If Not Application.Intersect(Range("A1:D20"), Target) Is Nothing Then

zu

If Not Application.Intersect(Target, Range("A1:D20", "E1:F20")) Is Nothing Then

Das Passwort steht in der Zeile

varEintrag = InputBox("Bitte das Löschen mit Kennwort bestätigen!") = "Passwort"

Option Explicit

Const bolSorted As Boolean = True       ' Legt fest, ob die Werte noch sortiert werden.
Dim blockedEvent As Boolean
Dim TargetOldText As String

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim varEintrag As Variant
 Dim strResult As String
 Dim strTarget As String
 Dim arrSorted As Variant
 Dim i As Long
 If Not Application.Intersect(Target, Range("A1:D20", "E1:F20")) Is Nothing Then
   On Error Resume Next
   Application.EnableEvents = False
   If Target.Count > 1 Then
     Application.Undo
   Else
     If IsEmpty(Target) Then
       varEintrag = InputBox("Bitte das Löschen mit Kennwort bestätigen!") = "Passwort"
     End If
     If Not varEintrag Then
       varEintrag = Target.Value
       Application.Undo
       If IsEmpty(Target) Then
         Target.Value = varEintrag
       Else
         MsgBox "Eintag ist nur in einer leeren Zelle möglich!", vbCritical
       End If
     Else
       MsgBox "Der Eintrag wurde nicht gelöscht, das das Kennwort falsch war!", vbCritical
     End If
   End If
   Application.EnableEvents = True
   On Error GoTo 0
 End If
 If Target.Column = 13 Or Target.Column = 24 Then
     strTarget = Trim$(Target.Value)
     If Not blockedEvent Then
         blockedEvent = True
         If Not TargetOldText = "" And Not Target.Value = "" Then
             If InStr(1, TargetOldText, Target.Value) > 0 Then
                 strResult = Replace(TargetOldText, ", " & strTarget, "")
                 strResult = Replace(strResult, strTarget & ", ", "")
                 strResult = Replace(strResult, strTarget, "")
             Else
                 strResult = TargetOldText & ", " & Target.Value
             End If
             If bolSorted Then
                 arrSorted = Split(strResult, ", ")
                 strResult = ""
                 Call Selectionsort(arrSorted)
                 For i = 0 To UBound(arrSorted)
                     strResult = strResult & arrSorted(i) & ", "
                 Next i
                 If Len(strResult) > 1 Then _
                 strResult = Left$(strResult, Len(strResult) - 2)
             End If
             Target.Value = strResult
         Else
             Target.Value = Target.Value
         End If
         TargetOldText = Target.Value
     Else
         blockedEvent = False
     End If
 Else
     TargetOldText = ""
 End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
TargetOldText = Target.Value
End Sub

Private Sub Selectionsort(ByRef data As Variant)
   Dim OG&, i&, j&, k&, h As Variant
   OG = UBound(data)
   For i = 0 To OG - 1
       h = data(i)
       k = i
       For j = i + 1 To OG
           If data(j) < h Then
               h = data(j)
               k = j
           End If
       Next j
       data(k) = data(i)
       data(i) = h
   Next i
End Sub


Gruß Uwe
Suchen
Top
Fredl55 Offline
Benutzer
ThreadStarter

Registriert seit: 16.10.2014
Version(en): 2013
#9
18.12.2015, 07:32
Hallo Uwe,
hab noch das Problem mit dem Kennwort, wenn ich statt dem Eintrag  PASSWORT ein neues Wort einfüge kommt immer noch -falsches kennwort-.-

Gruß Fred
Suchen
Top
Fredl55 Offline
Benutzer
ThreadStarter

Registriert seit: 16.10.2014
Version(en): 2013
#10
18.12.2015, 07:51
Sorry wenn ich mich falsch ausgedrückt habe es kommt die Meldung, konnte nicht gelöscht werden da Passwort falsch war.
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste