Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 12:38:40
Formeländerung durch Wechsel von Excel 2021 auf 2019
24.04.2024 12:31:18
Excel - Sverweis mit Wenn-Abfrage kombinieren
24.04.2024 12:16:26
Name von aktuellem VBA-Modul ausgeben
24.04.2024 12:07:15
Werte einer Liste vergleichen und markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1856to1860
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1856to1860
1856to1860
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

2x Private Sub Worksheet_Change zusammen

2x Private Sub Worksheet_Change zusammen
22.11.2021 10:33:57
Stefan
Hallo,
ich habe in einer Tabelle ein Makro im Hintergrund laufen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim EingabeBereich As Range
Set EingabeBereich = Intersect(Target, Columns(5))
If EingabeBereich Is Nothing Then Exit Sub
If WorksheetFunction.Count(EingabeBereich) = 0 Then Exit Sub
Application.EnableEvents = False
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
Zelle.Offset(0, 1).Value = Zelle.Offset(0, 1).Value + Zelle.Value
'Zelle.ClearContents
End If
Next
Application.EnableEvents = True
End Sub
Jetzt würde ich gerne davon ein zweites dazu packen, weiß aber nicht so recht wie ich das anstelle. Einfach so geht das ja nicht weil zwei "Private Sub Worksheet_Change" gehen ja nicht zusammen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim EingabeBereich As Range
Set EingabeBereich = Intersect(Target, Columns(5))
If EingabeBereich Is Nothing Then Exit Sub
If WorksheetFunction.Count(EingabeBereich) = 0 Then Exit Sub
Application.EnableEvents = False
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
Zelle.Offset(0, 1).Value = Zelle.Offset(0, 1).Value + Zelle.Value
'Zelle.ClearContents
End If
Next
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim EingabeBereich As Range
Set EingabeBereich = Intersect(Target, Columns(9))
If EingabeBereich Is Nothing Then Exit Sub
If WorksheetFunction.Count(EingabeBereich) = 0 Then Exit Sub
Application.EnableEvents = False
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
Zelle.Offset(0, -2).Value = Zelle.Offset(0, -2).Value + Zelle.Value
'Zelle.ClearContents
End If
Next
Application.EnableEvents = True
End Sub
Kann mir da jemand helfen, wie ich die beiden zusammen bekomme?
Danke
Schöne Grüße
Stefan

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2x Private Sub Worksheet_Change zusammen
22.11.2021 10:55:18
Rudi
auf die Schnelle:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim EingabeBereich As Range
Application.EnableEvents = False
Select Case Target.Column
Case 5
Set EingabeBereich = Intersect(Target, Columns(5))
If WorksheetFunction.Count(EingabeBereich) = 0 Then Exit Sub
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
Zelle.Offset(0, 1).Value = Zelle.Offset(0, 1).Value + Zelle.Value
End If
Next
Case 9
Set EingabeBereich = Intersect(Target, Columns(9))
If WorksheetFunction.Count(EingabeBereich) = 0 Then Exit Sub
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
Zelle.Offset(0, -2).Value = Zelle.Offset(0, -2).Value + Zelle.Value
End If
Next
End Select
Application.EnableEvents = True
End Sub
Gruß
Rudi
Anzeige
AW: 2x Private Sub Worksheet_Change zusammen
22.11.2021 11:09:27
Stefan
Vielen Dank Rudi, sowohl deine Variante als die vom UweD funktionieren wunderbar:
L Stefan
ein bisschen kompakter
22.11.2021 11:16:52
Rudi 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim EingabeBereich As Range
Dim iOffset As Integer
Select Case Target.Column
Case 5
Set EingabeBereich = Intersect(Target, Columns(5))
iOffset = 1
Case 9
Set EingabeBereich = Intersect(Target, Columns(9))
iOffset = -2
End Select
If WorksheetFunction.Count(EingabeBereich)  0 Then
Application.EnableEvents = False
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
Zelle.Offset(0, iOffset) = Zelle.Offset(0, iOffset) + Zelle
End If
Next
End If
Application.EnableEvents = True
End Sub

Anzeige
AW: 2x Private Sub Worksheet_Change zusammen
22.11.2021 10:55:31
UweD
Hallo
so?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim EingabeBereich As Range
Set EingabeBereich = Intersect(Target, Union(Columns(5), Columns(9)))
If EingabeBereich Is Nothing Then Exit Sub
If WorksheetFunction.Count(EingabeBereich) = 0 Then Exit Sub
Application.EnableEvents = False
For Each Zelle In EingabeBereich
If VarType(Zelle.Value) = vbDouble Then
If Target.Column = 5 Then
Zelle.Offset(0, 1).Value = Zelle.Offset(0, 1).Value + Zelle.Value
ElseIf Target.Column = 9 Then
Zelle.Offset(0, -2).Value = Zelle.Offset(0, -2).Value + Zelle.Value
End If
'Zelle.ClearContents
End If
Next
Application.EnableEvents = True
End Sub
LG UweD
Anzeige
AW: 2x Private Sub Worksheet_Change zusammen
22.11.2021 11:10:15
Stefan
Vielen Dank UweD, sowohl deine Variante als auch die vom Rudi funktionieren wunderbar:
L Stefan
AW: 2x Private Sub Worksheet_Change zusammen
22.11.2021 11:56:35
Daniel
Hi
Grundsätzlich ist es so, dass es immer nur ein Change-Event-Makro pro Tabellenblatt geben kann, welches automatisch ausgeführt wird.
hat man mehrere unterschiedliche Aktionen für unterschiedliche Zellbereiche, die ausgeführt werden müssen, dann ist die Grundregel:
verzichte auf das schnell und schlampig EXIT SUB, sondern schreibe ordentliche IF-Blöcke:
also statt:

If Bedingung1 then Exit Sub
hier der weitere Code
schreibt man:

if NOT Bedingung1 then
hier der weitere Code
End If
denn hier kann man dann weitere IF-Blöcke in beliebiger Anzahl anhängen, die auch dann abgearbeitet werden, wenn der erste nicht erfüllt ist.
in deinem fall sind aber die beiden Makros sehr ähnlich und machen fast das gleiche, da kann man das auch kompakter machen und in einen Ablauf packen:
ein paar Möglichkeiten das zu tun wurde dir ja schon gezeigt, ich pack nochmal eine drauf:

Dim Gütigkeitsbereich as Range
dim Zelle as Range
dim Off as long
Set Gültigkeitsbereich = Range("E:E,I:I")
if not Intersect(Target, Gültigkeitsbereich) is nothing then
for Each Zelle in Intersect(Target, Gültigkeitsbereich)
Off = IIF(Zelle.Column = 5, 1, -2)
Application.EnableEvents = False
if Isnumeric(Zelle.Value) then Zelle.Offset(0, Off).Value = Zelle.Offset(0, Off).Value + Zelle.Value
Application.EnableEvents = True
Next
End If
Gruß Daniel
Anzeige

301 Forumthreads zu ähnlichen Themen

Private Sub Worksheet_Change
Gordon

Moin,
ich habe folgenden Code:
Sub Anzahl_Klassen() Dim anzKl As Integer anzKl = Worksheets("Tabelle1").Cells(1, 2).Value With Worksheets("Tabelle1") If anzKl = 0 Then .Rows("5:102").RowHeight = 0 Else: .Rows("5:" & anzKl * 11 + 3).RowHeight = 12.75 .Rows(anzKl * 11 + 5 & ":10...
19.11.2008 10:35:41
Thread-ID: 1025907
5 Beiträge
Anzeige
Worksheet_Change(ByVal Target As Range)
Axel


Hallo Könner,
mal wieder an einem Punkt angekommen, wo ich echt nicht weiß, ob die PCs was Magisches können.
Das Makro unten ist prima gelaufen. Und dann mal wieder nicht. Jetzt gerade mal wieder nicht, daher mein Hilferuf. Als mir das das erste Mal passiert ist, habe ich den ganze...
13.03.2009 12:08:19
Thread-ID: 1059821
5 Beiträge
Private Sub Worksheet_Change kurz deaktivieren
Karsten

Hallo,
innerhalb der Befehle unter:
Private Sub Worksheet_BeforerightClick(ByVal Target As Range, Cancel As Boolean)
wird
Private Sub Worksheet_Change(ByVal Target As Range)
aufgerufen. Ich möchte dies aber für den einen Durchlauf verhindern. Kann mir jemand weiterhelfen,...
05.04.2009 19:12:12
Thread-ID: 1066944
7 Beiträge
Anzeige
Private Sub Worksheet_Change
Larissa

Hallo VBA-Künstler,
Ich habe in meiner Excelmappe schon ein längeres
Private Sub Worksheet_Change(ByVal Target As Range)
auf dem ersten Tabellenblatt eingebaut.
Bisher habe ich es nur so hinbekommen, dass die direkte Spalte angesprochen wird, in der man gerade etwas einträgt.
05.10.2009 19:39:36
Thread-ID: 1107325
18 Beiträge
Private Sub Worksheet_Change(ByVal Target As Range
ing.grohn

Hallo Forum,
Worksheet_Change ist eine wunderbare Sache! (wenn sie funktioniert)
Also:
ich arbeite in einem Blatt mit: Private Sub Worksheet_Change(ByVal Target As Range)
funktioniert alles super. Nur manchmal tut das nicht!!!!
Excel beenden, neu starten, alles klar und funk...
17.06.2010 09:43:52
Thread-ID: 1162378
11 Beiträge
Private Sub Worksheet_Change in Modul auslagern
Claudia

Hallo zusammen,
möchte folgenden Code aus Private Sub Worksheet_Change(ByVal Target As Range) in ein Modul auslagern. Soll heissen: unabhä _ _ ngig von einer Eingabe wie dargestellt soll ein Makro hingehen und prüfen, ob aufgrund der _ Werte im genannten I-Bereich noch Änderungen / Ergän...
12.09.2010 21:11:38
Thread-ID: 1177131
3 Beiträge
Private Sub Worksheet_Change
Claudia

Hallo zusammen,
brauche noch einmal Eure Hilfe! Ich nutze folgenden Code.
Wie müsste ich den Code ändern, wenn die Änderungen nicht in dem aktiven Blatt sondern im Reiter mit dem Namen "Test" der gleichen Datei erfolgen müsste. Geht das übergreifend?
Vielen DAnk!
LG
Claudia<...
19.12.2010 18:39:40
Thread-ID: 1192114
9 Beiträge
Problem mit Private Sub Worksheet_Change(ByVal Tar
Hans

Hallo, ich habe folgendes Problem,
Ich habe im Datenblatt ein PrivateSub Worksheet_Change .. wodurch 4 Formeln in die Zellen C5, D5 .. eingetragen.
Man gibt in Zelle B5 eine Ersatzteilnummer ein, dann werden in den folgenden 4 Zellen Bezeichnung, Preis und so weiter aus der Tabelle Pre...
06.01.2011 06:38:20
Thread-ID: 1194082
2 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
4
6
4
6
3
17
10
2
8
1
2
2
2
3
10
2
3
3
1
6
13
2
2
1
9