Microsoft Excel

Herbers Excel/VBA-Archiv

@ Hajo und Alle Excelaner | Herbers Excel-Forum


Betrifft: @ Hajo und Alle Excelaner von: Matthias
Geschrieben am: 19.02.2012 21:41:33

Hallo @ All,

ich benutze diesen Code von Hajo, der nun umgebaut werden müßte:

Option Explicit ' Variablendefinition erforderlich

Private Sub Worksheet_Change(ByVal Target As Range)
    '**************************************************
    '* H. Ziplies                                     *
    '* 13.10.11                                       *
    '* erstellt von HajoZiplies@web.de                *
'* http://Hajo-Excel.de/
 *
    '**************************************************
    Dim RaBereich As Range                  ' Variable Bereich
    Dim RaZelle As Range                    ' Variable Zelle
    ' Bereich der Wirksamkeit
    Set RaBereich = Range("E4:E55")
    ' noch mehr Bereiche
    'Set RaBereich = Union(Range("A5:A40 , C5:C40 , F5:F40 , J5:J40,  C21:AG21"), _
        Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
        Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
        Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
        Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
        Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
        Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
    ' nur die Zellen prüfen die im überwachten Bereich liegen
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    ' falls nicht gefunden wird Sub verlassen
    If Not RaBereich Is Nothing Then
        ' Reaktion auf Zellveränderung abschalten
        Application.EnableEvents = False
        ' Schleife über die geänderten Zellen des überwachten Bereichs
        For Each RaZelle In RaBereich
            ' Zellinhalt ist numerisch
            
            If IsNumeric(RaZelle) And IsNumeric(RaZelle.Offset(0, -1)) Then
                RaZelle.Offset(0, -1) = RaZelle.Offset(0, -1) + RaZelle
                RaZelle = ""
            End If
        Next RaZelle
        ' Reaktion auf Zellveränderung einschalten
        Application.EnableEvents = True
    End If
    Set RaBereich = Nothing                 ' Variable leeren
End Sub
===================================================
Ich benötige einen 2ten Bereich

Set RaBereich2 = Range("f4:f55")
der die selben "Zielzellen" subtrahiert

If IsNumeric(RaZelle) And IsNumeric(RaZelle.Offset(0, -2)) Then
RaZelle.Offset(0, -2) = RaZelle.Offset(0, -2) - RaZelle
RaZelle = ""

wie baue ich die For Schleife und if abfrage da ein?

Danke für Eure Unterstützung.

Gruß Matthias

  

Betrifft: Change-Prozedur für Addieren und Subtrahieren von: Erich G.
Geschrieben am: 20.02.2012 02:00:03

Hi Matthias,
meinst du das so?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   '**************************************************
   '* H. Ziplies                                     *
   '* 13.10.11                                       *
   '* erstellt von HajoZiplies@web.de                *
   '* www.Hajo-Excel.de
   '**************************************************
   Dim RaBereich As Range                 ' Variable Bereich
   Dim RaZelle As Range                   ' Variable Zelle
   Dim lngZ As Long                       ' Zeile der Zelle

         ' nur die Zellen prüfen die im überwachten Bereich liegen
   Set RaBereich = Intersect(Range("E4:F55"), Target)
         ' falls nicht gefunden wird Sub verlassen
   If Not RaBereich Is Nothing Then
            ' Reaktion auf Zellveränderung abschalten
      Application.EnableEvents = False
            ' Schleife über die geänderten Zellen des überwachten Bereichs
      For Each RaZelle In RaBereich
         lngZ = RaZelle.Row
         If IsNumeric(RaZelle) And IsNumeric(Cells(lngZ, 4)) Then
                  ' Zellinhalte sind numerisch
            Cells(lngZ, 4) = Cells(lngZ, 4) + _
               IIf(RaZelle.Column = 5, 1, -1) * RaZelle
            RaZelle.ClearContents
         End If
      Next RaZelle
            ' Reaktion auf Zellveränderung einschalten
      Application.EnableEvents = True
   End If
   Set RaBereich = Nothing                 ' Variable leeren
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: Danke Erich, so wars gedacht! .owT von: Matthias
Geschrieben am: 20.02.2012 10:57:11

.


  

Betrifft: AW: @ Hajo und Alle Excelaner von: Hajo_Zi
Geschrieben am: 20.02.2012 06:00:40

Hallo Matthias,

Du hast ein Set RaBereich =... zu viel, warum nicht einfach den Bereich beim 2. ergänzen?

GrußformelHomepage