Office: Format einer Zelle ändern in VBA

Hallo Leute,

brauche Eure Hilfe.

Ich habe einen Code den ich etwas ändern muss.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '   x in die Zelle
    Dim RaBereich As Range
    Set RaBereich = Range("D16:H18,D25:H25,D31:h32,d38:h39")
    If Intersect(Target, RaBereich) Is Nothing Then Exit Sub
    ' Abbruch, wenn Aktion nicht im Zielbereich
    Application.EnableEvents = False
    Cancel = True
    If Target.Value = "x" Then
        Target.Value = ""
    Else
        Target.Value = "x"
    End If
    Application.EnableEvents = True
    Set RaBereich = Nothing
End Sub

nun zum dem Problem :
Ich möchte das dieser mir im Bereich J18:U27 die ausgewählte Zelle wieder ins Standartformat setzt.
In diesen Zellen werden Zahlen oder % eingefügt wenn einmal % eingegeben wurden bleibt es drinnen deshalb der VBA Code.
Wichtig dabei ist das er dies nur macht wenn in der Zelle nichts drin steht, wenn 20% drinstehen darf dies nicht geändert werden in 20.


Vielen Dank
Gruß Rene

 

Moinsens!

Versuch's mal in der Art:

Code:

Private Sub FormatLoeschen(r As Range)
    Dim c As Range
    For Each c In r
        If (Trim$(c.Value) = "") Then
            c.NumberFormat = "General"
            'c.ClearFormats
            'c.Clear
        End If
    Next c
End Sub

Die Alternativen (auskommentiert) sind etwas härter: ClearFormats löscht auch Schriftarten, Farben usw. Clear ebenfalls, dazu den Inhalt auch. Aber wenn die Zelle eh leer ist... (Es gibt auch noch ClearContents = nur Werte löschen, aber Formate behalten.)

Aufruf dann über

Code:

FormatLoeschen Range("j18:u27")

Gruß, Michael

 

Hallo Michael,

danke für deinen Code mit Erklärung.
Ich habe ihn mal eingefügt und Probiert.
Die Funktion an sich funktioniert wunderbar, doch er läuft auf dem gesamten Arbeitsblatt.
Bei jeder Zelle die ausgewählt wird kontrolliert dieser ob es in dem angegebenen Bereich liegt.
das sieht man da ein kurzes Ladezeichen eingeblendet wird.

Wie kann ich dies auf den benötigten Bereich eingrenzen?

Danke
Gruß Rene

 

Moinsens!

Das hängt davon ab, wo du die Routine aufrufst.

Du hast ja so ein "If Intersect ..." in Deiner Routine. Damit prüfst Du, ob "Target", also der Parameter, der in die Routine reinkommt, innerhalb des gewünschten Bereiches liegt. Wenn nicht, machst Du ein "Exit Sub", ansonsten läuft die eigentliche Behandlung los. Und auch nur in diesem zweiten Fall darf dann die "FormatLoeschen" Routine aufgerufen werden.

Vielleicht noch als Tip, um das Laufzeitverhalten etwas zu verbessern:

Das "SelectionChanged" Ereignis dürfte das so ziemlich am häufigsten abgefeuerte Ereignis sein. Bei jedem Wechsel des Cursors wird Deine Routine durchlaufen, auch wenn es nur bis zum Intersect ist. Ich mag dieses Ereignis eigentlich gar nicht und vermeide es, wenn ich irgendeine andere Möglichkeit sehe.

Sehr viel seltener und wirklich nur gewollt wird das "BeforeDoubleClick" Ereignis aufgerufen. Die Syntax ist fast die gleiche und Du kannst Deinen Code fast ohne Änderungen auf das "Change" Ereignis umstellen. Und ich vermute fast, daß die Zeile "Cancel = True" vielleicht sogar ein Überbleibsel aus einem Versuch mit diesem Ereignis ist und du kein "Option Explicit" benutzt, weswegen die Zeile jetzt wirkungslos, aber auch ohne Fehlermeldung, noch in Deinem Code steht. Mit dem Doppelklick Ereignis kannst Du auch eine Zelle mehrmals von "" auf "x" und wieder zurück umstellen. Mit "SelectionChange" ist das nicht möglich.

Was Dein Code übrigens auch nicht macht: Wenn man einen Bereich aus mehreren Zellen selektiert, müßtest Du ggf. auch in einer gesonderten Form darauf reagieren. Mit "if (target.cells.count <> 1) then exit sub" würdest Du z.B. die Abarbeitung dann ebenfalls abbrechen. Das Problem (mehrere Zellen) würde sich beim Doppelklick übrigens auch gar nicht erst stellen...

(Alternativ könntest Du natürlich auch mit einer "For Each" Schleife alle Zellen des selektierten Bereichs durchlaufen und "" und "x" setzen. Syntax: Siehe FormatLoeschen Routine...)

Und noch ein Tip: Das "exit sub" würde ich vermeiden, wenn irgend möglich, und das ist es eigentlich immer. Das "exit sub" unterscheidet sich nicht sehr von einem "goto", und das vermeidet man wie der Teufel das Weihwasser. Eine leichte Umstellung (Umkehrung der Abfragen) macht das schön möglich.

Statt

Code:

if (intersect... is nothing) then exit sub
[ mach was ]

sieht es viel schöner aus mit

Code:

if ([COLOR=#ff0000]not[/COLOR] intersect... is nothing) then
    [ mach was ]
end if

Und zusätzlich auf mehrere Zellen abgeprüft dann:

Code:

if (target.cells.count = 1) then
    if (not intersect... is nothing) then
        [ mach was ]
    end if
end if

Gruß, Michael

 

Guten Morgen Michael,



vielen Dank für die Erklärung der Formel, bin noch relativ neu im VBA Bereich und daher ist dies Gold wert für mich.



Wenn ich diese Testmappe probiere löscht es mir im Bereich J18:U27 nicht das Format.

Aber wenn ich dies echt so umstelle auf BeforeDoubleClick könnte ich mir einen Teil sparen.

Der Teil der das Format zurücksetzen soll kann dies so bei jedem doppelklick in diesem Bereich machen.



Beispiel:

in Zelle J18 steht 50% ich möchte 20,42 drin stehen haben.

Somit klicke ich doppelt auf diese Zelle der Code löscht alles auch das Format und ich kann die Zahl reinschreiben.

Will ich diese wieder ändern ist es ja egal ob er mir diese davor wieder löscht.

Da müsst ich evtl. nur dran hängen das er nachdem er das Format gelöscht hat diese Zelle aktiviert das auch rein geschrieben werden kann.


Hab es mal versucht in der Testmappe aber es funkt nicht. lol

Gruß Rene

 

Moinsens!

Doch, doch... Tut's schon, aber nur in den Zellen, die "leer" sind. Von daher siehst Du den Effekt nicht wirklich sofort.

Versuch mal in meiner Beispiel-Mappe:
a) Markiere den "rechten" Bereich J18:I27
b) Formatiere die Zellen als "Zahl" mit 2 Nachkommastellen und 1000er-Punkt.
c) Trage ein paar Zahlen in den Bereich ein.
d) Doppelklicke auf einen der "linken" Bereiche.
e) Markiere eine leere Zelle im "rechten" Bereich und schau Dir das Format an: ""Standard" (also "General")

Aus der Beschreibung werd ich jetzt nicht ganz schlau. Aber ich schau nachher vieleicht noch mal rein, bin gerade auf dem Sprung...

Gruß, Michael

 

Hallo

Ich meinte wenn ich 10% in J20 reinschreibe und dies wieder lösche, kann ich sooft ich will doppelt drauf klicken das % taucht immer wieder auf.
Dies sollte es löschen.

Gruß Rene

 

Hallo

Hab es hinbekommen

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim RaBereich As Range
    Dim RaBereich2 As Range

    If (Target.Cells.Count = 1) Then

        Set RaBereich = Range("D16:H18,D25:H25,D31:h32,d38:h39")
        Set RaBereich2 = Range("J18:U27")
        If (Not Intersect(Target, RaBereich) Is Nothing) Then
            Application.EnableEvents = False
            Cancel = True
            If Target.Value = "x" Then
                Target.Value = ""
            Else
                Target.Value = "x"
            End If
            
            Application.EnableEvents = True
            Set RaBereich = Nothing

        End If
        If (Not Intersect(Target, RaBereich2) Is Nothing) Then
            Application.EnableEvents = False
            Cancel = True
                Target.Clear
            Application.EnableEvents = True
            Set RaBereich = Nothing
        End If
        
    End If

End Sub

Danke für deine Hilfe
Gruß Rene

 

Moinsens!

Sauber!

Dein ursprünglicher Code reagierte nur auf Doppelklicks (bzw. ganz ursprünglich nur auf Cursorwechel) in einem der "linken" Bereiche. Das wurde mit RaBereich überprüft.

Mir war nicht ganz klar, daß Du auch auf einen Doppelklick im "rechten" Bereich reagieren wolltest. Deswegen mein letztes, etwas ratloses, Posting.

Sieht gut aus! Freut mich, daß Du es selbst hinbekommen hast.

Noch ein bißchen was zum Thema "stilvoll":

Das äußere "If" Konstrukt kannst Du auskommentieren / löschen. Beim Doppelklick kann es per se keinen Bereich mit mehr als einer Zelle geben. Deswegen ist die Abfrage auf target.cells.count überflüssig. Ich hatte das Auskommentieren leider vergessen, als ich es vom "SelectionChange" übertragen hatte. Sorry...

Du löscht (grundsätzlich völlig korrekterdings) die mit "Set" gesetzten Bereichs-Variablen, aber...
a) Wohl ein Tippfehler: Du löscht in beiden Fällen RaBereich, aber RaBereich2 (unterer Teil) wird nicht gelöscht.
b) Das Löschen der Variablen passiert in einer "tieferen" IF-Ebene, als das Setzen. Im Zweifelsfall wird die Variable also gesetzt, das IF ergibt "false" und das Löschen im THEN-Zweig wird nie erreicht.

Du löscht das Format ziemlich "brutal" mit "Clear". Das löscht nicht nur das Zahlenformat, sondern auch, neben dem Zellwert, Schrift- und Hintergrundfarbe, Rahmen usw. Überleg Dir also, ob ein

Code:

Target.NumberFormat = "General"

nicht vielleicht sinnvoller ist...

Das Application.Dis/EnableEvents:
a) Überleg Dir genau, ob Du das wirklich brauchst. Das Abschalten von Events hat meist mehr negative als positive Wirkungen. Du solltest sie nur abschalten, wenn Du befürchten mußt, daß sich Events gegenseitig überschneiden / beeinflussen oder ein Event ein zweites mal aufgerufen wird, bevor es das erste mal komplett abgearbeitet wurde.
b) Und wenn es notwendig ist: Erledige das über das komplette Event. Soll heißen: "disable" gleich am Anfang der Routine, "enable" entsprechend ganz am Ende. Und paß dabei auf, das Reaktivieren nicht durch Fehlerbehandlungs-Verzeigungen o.ä. zu verpassen. So ein blödes "Exit Sub" (aber das wollen wir eigentlich ja eh nicht mehr benutzen...) an ungünstiger Stelle kann da ganz ekelhafte Folgen haben:

Code:

Public Function Division(Zaehler As Single, Nenner As Single)
    Dim Result As Single
    Application.EnableEvents = False
    If (Nenner = 0) Then Exit Sub
    Result = Zaehler / Nenner
    Division = Result
    Application EnableEvents = True
end sub

Wenn Du diese Routine mit einem "Nenner" von "0" aufrufst, kannst Du den Events im weiteren Verlauf noch ein leises Arrivederci hintermurmeln. Auch das hier geht schief:

Code:

Public Function Division(Zaehler As Single, Nenner As Single)
    Dim Result As Single
    Application.EnableEvents = False
    On Error Goto DivisionFehler
    Result = Zaehler / Nenner
    Application EnableEvents = True
DivisionEnde:
    Division = Result
    Exit Sub
DivisionFehler:
    MsgBox "Fehler!"
    Resume DivisionEnde
end sub

Wobei hier das "enable" nur eine Zeile tiefer muß, hinter das "DivisionEnde" Label, denn dort geht's in jedem Fall, auch durch das "Resume" im Fehlerfall, weiter.

Von daher:

Code:

        ' Application.EnableEvents = False
        ' If (Target.Cells.Count = 1) Then
        Set RaBereich = Range("D16:H18,D25:H25,D31:h32,d38:h39")
        Set RaBereich2 = Range("J18:U27")
        If (Not Intersect(Target, RaBereich) Is Nothing) Then
            ' [ ... ]
        End If
        If (Not Intersect(Target, RaBereich2) Is Nothing) Then
            ' [ ... ]
        End If
        Set RaBereich = Nothing
        Set RaBereich2 = Nothing
        ' End If
        ' Application.EnableEvents = True

Gruß, Michael