2 Worksheet_Change Ereignisse in einem

Question

Hallo zusammen,

ich möchte 2 worksheet_change Ereignisse in einem Tabellenblatt vereinen was ich natürlich gleich probiert habe wo es dann natürlich zu der Fehlermeldung kommt das man 2 gleiche Ereignisse nicht benutzen darf oder zumindestens nicht 2 mal den selben Namen.

folgende Subs habe ich

Private Sub Worksheet_Change(ByVal Target As Range)
'Übergabe
Dim rngZelle As Range
For Each rngZelle In Target.Cells
If rngZelle.Column = 7 Then 'wenn in spalte etwas steht führe aus
If rngZelle.Row >= 3 Then 'reagiere erst ab Zeile 4
If rngZelle.Row < 10001 Then
If Trim(rngZelle.Text) <> "" Then
Cells(rngZelle.Row, 21).FormulaR1C1 = "=IF(RC[-14]="""","""",MID(RC[-14],6,7)*1)" 'schreibe in Spalte 21
End If
End If
End If
End If
Next
End Sub

und dieses soll integriert werden

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As Integer, z As Integer
s = Target.Column
z = Target.Row
If s <> 1 Then Exit Sub
Call Doppelte_suchen(z, s)
End Sub

probiert habe ich es so, dann hängt sich das Sub auf

Private Sub Worksheet_Change(ByVal Target As Range)
'Übergabe
Dim rngZelle As Range
Dim s As Integer, z As Integer
s = Target.Column
z = Target.Row
If s <> 2 Then Exit Sub
Call Doppelte_suchen(z, s)
For Each rngZelle In Target.Cells
If rngZelle.Column = 7 Then 'wenn in spalte etwas steht führe aus
If rngZelle.Row >= 3 Then 'reagiere erst ab Zeile 4
If rngZelle.Row < 10001 Then
If Trim(rngZelle.Text) <> "" Then
Cells(rngZelle.Row, 21).FormulaR1C1 = "=IF(RC[-14]="""","""",MID(RC[-14],6,7)*1)" 'schreibe in Spalte 21
End If
End If
End If
End If
Next
End Sub

oder so, was sich natürlich auch aufhängt

Private Sub Worksheet_Change(ByVal Target As Range)
'Übergabe
Dim rngZelle As Range
For Each rngZelle In Target.Cells
If rngZelle.Column = 7 Then 'wenn in spalte etwas steht führe aus
If rngZelle.Row >= 3 Then 'reagiere erst ab Zeile 4
If rngZelle.Row < 10001 Then
If Trim(rngZelle.Text) <> "" Then
Cells(rngZelle.Row, 21).FormulaR1C1 = "=IF(RC[-14]="""","""",MID(RC[-14],6,7)*1)" 'schreibe in Spalte 21
End If
End If
End If
End If
Next
Dim s As Integer, z As Integer
s = Target.Column
z = Target.Row
If s <> 2 Then Exit Sub
Call Doppelte_suchen(z, s)
End Sub

Ich hab mir zwar ein Buch vom Bildner Verlag besorgt aber da steht sowas natürlich nicht drin. :-)

Wie kann ich denn nun 2 solcher Ereignisse vereinen?

Gruß

energun222

Answer 1

Was verstehst du unter "hängt sich auf"?
Welche Fehlermeldungen bekommst du?
Funktionieren die beiden Subs wenn du sie einzeln verwendest?

Gruß Flupo

Answer 2

Hallo,

versuch es mal so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngZelle As Range
Dim s As Integer
Dim z As Integer

If Target.Column = 1 Then
s = Target.Column
z = Target.Row
Call Doppelte_suchen(z, s)
Exit Sub
End If

For Each rngZelle In Target.Cells
If rngZelle.Column = 7 Then 'wenn in spalte etwas steht führe aus
If rngZelle.Row >= 3 Then 'reagiere erst ab Zeile 4
If rngZelle.Row < 10001 Then
If Trim(rngZelle.Text) <> "" Then
Cells(rngZelle.Row, 21).FormulaR1C1 = "=IF(RC[-14]="""","""",MID(RC[-14],6,7)*1)" 'schreibe in Spalte 21
End If
End If
End If
End If
Next
End Sub

Fügst du hier etwas ein oder für was brauchst du die Each-Schleife?

Gruß

M.O.

Answer 3

Hallo zusammen,

mit hängt sich auf meine ich das das 2te Makro dann nicht mehr zu beenden ist oder eben nicht mehr richtig funktioniert.

Ich hab einfach mal eine meine Datei hochgeladen.

Tabelle 1 und 2 gehören zusammen und Tabelle 3 ist für sich allein

Beide Makros funktionierten von einander getrennt super. Beide Makros sind natürlich nicht von mir sondern wurden in den Weiten des www gefunden.

https://www.dropbox.com/s/tt0zrqqfy6o56lx/doppelt.xlsm?dl=0

Gruß

Answer 4

Hallo,

jetzt hab ich abgeschickt und wusste net das da schon jemand geschrieben hat.

Hat wieder mal super geklappt M.O.


Gruß

energun222