Microsoft Excel

Herbers Excel/VBA-Archiv

Workbook_SheetChange

Betrifft: Workbook_SheetChange von: Peter
Geschrieben am: 12.09.2014 20:35:42

Guten Abend

Damit ich einen negativen Betrag im Format n- und -n eingeben kann, habe ich folgenden Code bei DieseArbeitsmappe hinterlegt:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Left(Target, 1) <> "-" And Right(Target, 1) = _
"-" And IsNumeric(Left(Target, Len(Target) - 1)) Then
Target = "-" & Left(Target, Len(Target) - 1)

Else
End If

End Sub

Nun kriege ich noch Probleme, wenn die Selektion mehrere Zellen umfasst. Wie kann ich das abfangen?

Gruss, Peter

  

Betrifft: AW: Workbook_SheetChange von: Beverly
Geschrieben am: 12.09.2014 21:40:47

Hi Peter,

sollen bei Mehrfachmarkierung alle Zellen geändert werden oder soll dann gar nichts passieren?


GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Workbook_SheetChange von: Peter
Geschrieben am: 12.09.2014 21:52:00

Hallo Karin
Es wäre praktisch, beide Varianten zu kennen :-)

Gruss
Peter


  

Betrifft: AW: Workbook_SheetChange von: Beverly
Geschrieben am: 12.09.2014 22:31:41

Hi Peter,

versuche es mal so:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
      For Each Target In Target
         If Len(Target) > 1 Then
            If Left(Target, 1) <> "-" And Right(Target, 1) = _
               "-" And IsNumeric(Left(Target, Len(Target) - 1)) Then
               Application.EnableEvents = False
               Target = "-" & Left(Target, Len(Target) - 1)
               Application.EnableEvents = True
            End If
         End If
      Next Target
End Sub

GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Workbook_SheetChange von: Daniel
Geschrieben am: 12.09.2014 22:36:46

Hi
Variante a) nichts machen wenn mehrer Zellen ausgewählt werden:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.CountLarge > 1 Then Exit sub
   Application.EnableEvents = False
   If Left(Target, 1) <> "-" And Right(Target, 1) = _
          "-" And IsNumeric(Left(Target, Len(Target) - 1)) Then
       Target = "-" & Left(Target, Len(Target) - 1)
   End If
   Application.EnableEvents = True
End Sub

Variante b) Jede Zelle bearbeiten, per Schleife
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Zelle as Range

Application.enableEvents = False
For Each Zelle in Intersect(Target, sh.UsedRange)
    If Left(Zelle, 1) <> "-" And Right(Zelle, 1) = _
             "-" And IsNumeric(Left(Zelle, Len(Zelle) - 1)) Then
       Zelle = "-" & Left(Zelle, Len(Zelle) - 1)
    End If
Next
Application.enableEvents = True
End Sub
das Application.EnableEvents = False verhindert den rekursiven Selbstaufruf des Makros (muss hinterher wieder aktiviert werden, denn diese Einstellung bleibt bei Makroende erhalten!)

das Intersect(Target, sh.Usedrange) verhindert überlange Laufzeiten, wenn du mal ne ganze Spalte bearbeitest (z.B. beim löschen)

Gruß Daniel


  

Betrifft: AW: Workbook_SheetChange von: Peter
Geschrieben am: 15.09.2014 22:38:28

Hallo zusammen
Vielen Dank. Ich habe den Code von Daniel übernommen, diesen dann noch mit der Bedingung aus dem Code von Karin ergänzt (Abfrage, ob Targetlänge grösser als 1 ist).

So ist's prima.

Gruss, Peter