Prozedur in Worksheet_Change teilen
Sayjuri
bin seit einiger Zeit dabei herauszufinden wie man eine Prozedur in einem Worksheet Change teilen und aufrufen kann. Ich hoffe ich drücke mich hier einigermaßen verständlich aus, bin nämlich was VBA betrifft noch ein Laie. Auf der Suche nach Antworten im Net bin ich zwar immer wieder auf ähnliche Problemstellungen gestoßen allerdings haben die Antworten mich noch nicht weitergebracht.
Was ich versuche bzw. was auch schon geklappt hat ist, ein Worksheet Change (ByVal Target As _
Range) zu erstellen der eine Art Optionsfeld nachahmt. Drei Zellen sollen z.B. zu einer _ Optionsgruppe zusammengefasst werden (z.B. B1:B3) und wenn ich in B1 zuerst einen Eintrag vornehme und dann in B2 oder B3 etwas eintrage dann soll der Eintrag in B1 gelöscht werden. Dies klappt auch sehr schön mit folgendem Code (ich hoffe Code ist der richtige Begriff :o)
Private Sub Worksheet_Change(ByVal Target As Range)
'Kreuzoption 1
If Not Intersect(Target, [B1:B1]) Is Nothing Then
If Not ActiveSheet.Cells(1, 2).Value = "" Then
ActiveSheet.Cells(2, 2).Value = ""
ActiveSheet.Cells(3, 2).Value = ""
End If
ElseIf Not Intersect(Target, [B2:B2]) Is Nothing Then
If Not ActiveSheet.Cells(2, 2).Value = "" Then
ActiveSheet.Cells(1, 2).Value = ""
ActiveSheet.Cells(3, 2).Value = ""
End If
ElseIf Not Intersect(Target, [B3:B3]) Is Nothing Then
If Not ActiveSheet.Cells(3, 2).Value = "" Then
ActiveSheet.Cells(1, 2).Value = ""
ActiveSheet.Cells(2, 2).Value = ""
End If
End If
End Sub
Wie gesagt funktioniert dieser "Code"? auch ganz gut mein Problem ist aber das ich ungefähr 50 (oder in Zukunft auch noch mehr) dieser Optionsgruppen brauche und im eigentlichen Fall jede Optionsgruppe nicht nur drei sonder vier Zellen beinhaltet. Das führt dann irgendwann dazu dass ich die Fehlermeldung bekomme die Prozedur sei zu groß.
Ich habe jetzt versucht die Prozedur auf folgende Art und Weise zu teilen (wobei die Zellen B5: _
B7 eine neue Optionsgruppe ergeben sollen):
Private Sub Worksheet_Change(ByVal Target As Range)
'Kreuzoption 1
If Not Intersect(Target, [B1:B1]) Is Nothing Then
If Not ActiveSheet.Cells(1, 2).Value = "" Then
ActiveSheet.Cells(2, 2).Value = ""
ActiveSheet.Cells(3, 2).Value = ""
End If
ElseIf Not Intersect(Target, [B2:B2]) Is Nothing Then
If Not ActiveSheet.Cells(2, 2).Value = "" Then
ActiveSheet.Cells(1, 2).Value = ""
ActiveSheet.Cells(3, 2).Value = ""
End If
ElseIf Not Intersect(Target, [B3:B3]) Is Nothing Then
If Not ActiveSheet.Cells(3, 2).Value = "" Then
ActiveSheet.Cells(1, 2).Value = ""
ActiveSheet.Cells(2, 2).Value = ""
End If
End If
Call Worksheet_Change2
End Sub
Public Sub Worksheet_Change2(ByVal Target As Range)
'Kreuzoption 2
If Not Intersect(Target, [B5:B5]) Is Nothing Then
If Not ActiveSheet.Cells(5, 2).Value = "" Then
ActiveSheet.Cells(6, 2).Value = ""
ActiveSheet.Cells(7, 2).Value = ""
End If
ElseIf Not Intersect(Target, [B6:B6]) Is Nothing Then
If Not ActiveSheet.Cells(6, 2).Value = "" Then
ActiveSheet.Cells(5, 2).Value = ""
ActiveSheet.Cells(7, 2).Value = ""
End If
ElseIf Not Intersect(Target, [B7:B7]) Is Nothing Then
If Not ActiveSheet.Cells(7, 2).Value = "" Then
ActiveSheet.Cells(5, 2).Value = ""
ActiveSheet.Cells(6, 2).Value = ""
End If
End If
End Sub
-----------------------------------------------------------------------
Hier erscheint dann die Fehlermeldung das Argument sei nicht Optional dabei wird "Call Worksheet_Change2" blau markiert und
-Private Sub Worksheet_Change(ByVal Target As Range)- gelb markiert.
Was mich jetzt interessiert sind zwei Sachen:
1. Was mache ich bei dieser Teilung falsch? und wie mach ich es richtig :o)
2. Gibt es auch eine Möglichkeit den Code so zu schreiben, dass ich nicht für jede _
Optionsgruppe die einzelnen Zellen händisch eintragen muss. Das war nämlich ganz schön viel _
Tipparbeit auch wenn man das Grundgerüst immer wieder kopieren konnte.
Wenn ihr mir hier weiterhelfen könntet wäre ich wirklich sehr dankbar. Bin nämlich schon seit _
_
_
einigen Tagen am rumsuchen.
Vielen dank schon mal im Voraus an jeden der sich hier die Mühe macht mein Problem _
nachzuvollzien.
Gruß Sayjuri