Einzelnen Beitrag anzeigen
Alt 09.02.2018, 20:06   #52
Boost12
MOF User
MOF User
Standard

Hi!

Habe es geschafft, das mir meine Zellen von Spalte 30 bis 222 gelöscht werden, wenn sie in Werte umgewandelt werden.

hier mal der Code


Code:

Sub löschen()
' löschen Makro
    Range("AC5:HN65").SpecialCells(xlCellTypeConstants).ClearContents
End Sub
Habe deinen Code der mir die neue nächste Zeile nach unten kopiert etwas abgeändert da es ja ein Problem mit ihm gibt, wenn man den Code in der freigegebenen Mappe ausführen will.

So funktioniert er ohne Probleme

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Column
Case 4
If Target.Count = 1 Then
If Target <> "" Then
If Target.Offset(-1, 0) <> "" And Target.Offset(1, 0) = "" Then
Application.EnableEvents = False
' kopieren in die nächste Zeile
Range(Cells(Target.Row, 2), Cells(Target.Row, 227)).Copy Cells(Target.Row + 1, 2)
' alle Zellen die keine formeln enthalten leeren
Range(Cells(Target.Row + 1, 3), _
Cells(Target.Row + 1, 23)).SpecialCells(xlCellTypeConstants).ClearContents
' in Spalte C nächste Numemr eintragen
Cells(Target.Row + 1, 3) = Cells(Target.Row, 3) + 1
                End If
                 Application.EnableEvents = True
                End If
            End If
        Target.Offset(1, 0).Select
    Case 9, 11, 13, 15, 17
        Target.Offset(0, 1).Value = Time
    End Select
End Sub
Jedoch musste ich den Teil löschen, der für die doppelten Werte wichtig war.
Wenn ich den Code so übernehme, bricht der Code beim ausführen in der freigegebenen Mappe ab und man kann den Debugger nicht öffnen.

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim lngLetzte As Long
Dim intZaehler As Integer
    Select Case Target.Column
        Case 4
            If Target.Count = 1 Then
            If Target <> "" Then
            If Target.Offset(-1, 0) <> "" And Target.Offset(1, 0) = "" Then
                lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count)
                Application.EnableEvents = False
        ' kopieren in die nächste Zeile
        Range(Cells(Target.Row, 2), Cells(Target.Row, 227)).Copy Cells(Target.Row + 1, 2)
        ' alle Zellen die keine formeln enthalten leeren
        Range(Cells(Target.Row + 1, 3), _
        Cells(Target.Row + 1, 23)).SpecialCells(xlCellTypeConstants).ClearContents    
       ' in Spalte C nächste Numemr eintragen
        Cells(Target.Row + 1, 3) = Cells(Target.Row, 3) + 1
         ' wenn S5 eine bedingte Formatierung enthält
        If Cells(5, 19).FormatConditions.Count > 0 Then
         ' alle bedingten Formatierungen ab Zeile 6 löschen
        Range(Cells(6, 19), Cells(lngLetzte, 19)).FormatConditions.Delete
        ' Schleife über alle bedingten Formatierungen Zelle S5
        For intZaehler = 1 To Cells(5, 19).FormatConditions.Count
       ' neuen Bereich festlegen
        Cells(5, 19).FormatConditions(intZaehler).ModifyAppliesToRange Range("S$5:$S$" & lngLetzte)
                    Next intZaehler
                End If
                 Application.EnableEvents = True
                End If
            End If
        End If
        Target.Offset(1, 0).Select
    Case 9, 11, 13, 15, 17
        Target.Offset(0, 1).Value = Time
    End Select
End Sub
Gibt es da vielleicht eine andere Möglichkeit?
Das ich die doppelten Werte in der Spalte S mit einem Makro durch betätigen eines Buttons ermitteln und farblich rot makieren kann?

Der Coder zum Umwandeln der Formeln in Werte klappt ohne Probleme.
Hier nochmal der Code, angepasst an meine Tabelle.

Code:

Sub Umwandeln()
Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count) - 1
Range(Cells(6, 3), Cells(lngLetzte, 23)).Copy
Cells(6, 3).PasteSpecial Paste:=xlValues
Range(Cells(5, 30), Cells(lngLetzte, 227)).Copy
Cells(5, 30).PasteSpecial Paste:=xlValues
Range("D6").Select
End Sub

Du hattest mir auch einen Code geschrieben, der verhindern soll, dass die Anwender, Zellen in denen eine Formel steht nicht auswählen können.
Dies funktioniert auch ohne Probleme.

Dann hattest du hin erweitert, dass auch Zellen in denen die Formeln in Werte umgewandelt werden nicht auswählbar sein sollten.

Jedoch funktioniert dieser Code nicht.
Es können weiterhin Zellen mit Formeln nicht ausgewählt werden aber immer noch die Zellen in denen nun Werte stehen.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count)
If Cells(Target.Cells(1).Row, Target.Cells(1).Column).HasFormula Then Target.Offset(0, 1).Select
End Sub
Kann man dies vielleicht noch ändern und so anpassen, das die Zellen in denen vorher Formeln standen und nun Werte stehen nicht von Anwender auswählbar sind?

Die Spalten um die es geht wären die Spalten E,F,G,H,S und T und vielleicht noch die Spalte C in der die laufende Nummer steht.

Wenn die Zwei Sachen 1. doppelte Werde ermitteln = rot und 2. nicht auswählbar der genannten Spalten funktioniert haben wir es bzw du :-) endlich geschafft.

Ich danke dir und wünsche dir ein schönes Wochenende.

lg :-)
Boost12 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten