@ Hajo und Alle Excelaner

Forumthread: @ Hajo und Alle Excelaner

Matthias

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Change-Prozedur für Addieren und Subtrahieren

20.02.2012 02:00:03

Erich

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

Danke Erich, so wars gedacht! .owT

20.02.2012 10:57:11

Matthias

AW: @ Hajo und Alle Excelaner

20.02.2012 06:00:40

Hajo_Zi

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

Beliebteste Forumthreads (12 Monate)

Forumthread: @ Hajo und Alle Excelaner

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread