PDA

Vollständige Version anzeigen : Wenn Zellen gefüllt, dann Makro ausführen


Mikrofon
01.09.2017, 15:11
Hi,

ich habe hier schonmal Hilfe von euch bekommen und das hat mir schon viel geholfen.

Damals brauchte ich ein Makro, welches ein anderes Makro ausführt, sobald 4 Zellen gefüllt sind.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean
If Intersect(Target, Range("P9:S9")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
blnTuwat = True
For Each Zelle In Range("P9:S9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Lebenshaltung
Application.EnableEvents = True
End If
End Sub

Das funktioniert auch soweit.

Nun müssten auf dem Blatt mehrere Zellenbereiche abgefragt werden und dann jeweils unterschiedliche Makro aufgerufen werden.
Also wenn Zellen P9:S9 gefüllt sind dann soll Makro1 ausgeführt werden.
Wenn U9:X9 gefüllt, dann soll Makro2 ausgeführt werden usw.
Auf Anhieb hab ich es mal so versucht:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean
If Intersect(Target, Range("P9:S9")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
blnTuwat = True
For Each Zelle In Range("P9:S9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Lebenshaltung
Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean
If Intersect(Target, Range("U9:X9")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
blnTuwat = True
For Each Zelle In Range("U9:X9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Anschaffungen
Application.EnableEvents = True
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean
If Intersect(Target, Range("Z9:AC9")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
blnTuwat = True
For Each Zelle In Range("Z9:AC9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Wohnen
Application.EnableEvents = True
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean
If Intersect(Target, Range("AE9:AH9")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
blnTuwat = True
For Each Zelle In Range("AE9:AH9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Auto
Application.EnableEvents = True
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean
If Intersect(Target, Range("AJ9:AM9")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
blnTuwat = True
For Each Zelle In Range("AJ9:AM9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Bank
Application.EnableEvents = True
End If
End Sub

Das hat Leider nicht funktioniert.
Hat vielleicht jemand eine Lösung für das Problem.

Danke fürs durchlesen und auch danke falls ihr mir Helfen könnt.

Grüße

Storax
01.09.2017, 15:33
Willst Du mit dem Code sagen, Du hast mehrmals Private Sub Worksheet_Change(ByVal Target As Range) in das Klassenmodul für die Tabelle eingefügt?

Grob und schnell angepasst könnte das so aussehen. Weitere Rückfragen werden ohne Beispieldatei nicht beantwortet.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim blnTuwat As Boolean


If Target.Cells.Count > 1 Then
Exit Sub
End If


If Intersect(Target, Range("P9:S9")) Is Nothing Then
Else
blnTuwat = True
For Each Zelle In Range("P9:S9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Lebenshaltung
Application.EnableEvents = True
End If
Exit Sub
End If


If Intersect(Target, Range("U9:X9")) Is Nothing Then
Else
blnTuwat = True
For Each Zelle In Range("U9:X9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Anschaffungen
Application.EnableEvents = True
End If
Exit Sub
End If

If Intersect(Target, Range("Z9:AC9")) Is Nothing Then
Else
blnTuwat = True
For Each Zelle In Range("Z9:AC9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Wohnen
Application.EnableEvents = True
End If
Exit Sub
End If


If Intersect(Target, Range("AE9:AH9")) Is Nothing Then
Else
blnTuwat = True
For Each Zelle In Range("AE9:AH9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Auto
Application.EnableEvents = True
End If
Exit Sub
End If


If Intersect(Target, Range("AJ9:AM9")) Is Nothing Then
Else
blnTuwat = True
For Each Zelle In Range("AJ9:AM9")
If Zelle.Value = "" Then
blnTuwat = False
End If
Next Zelle
If blnTuwat Then
Application.EnableEvents = False
Call Neue_Reihe_Bank
Application.EnableEvents = True
End If
Exit Sub
End If

End Sub

drambeldier
01.09.2017, 15:36
Moin,
Das hat Leider nicht funktioniert.
dass da ein Fehler beim Compilieren auftritt, stört Dich nicht?

Die Prozedur zum Ereignis kann es nur einmal geben, also

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Zelle As Range
Dim blnTuwat As Boolean

If Not Intersect(Target, Range("P9:S9")) Is Nothing Then
...
End If
If Not Intersect(Target, Range("u9:x9")) Is Nothing Then
...
End If
If Not ...
End If
End Sub

Mikrofon
01.09.2017, 16:07
Danke für die Hilfe, es hat geklappt :) Vielen Dank für die Hilfe