Microsoft Excel

Herbers Excel/VBA-Archiv

worksheet change 2 Subs zusammenführen | Herbers Excel-Forum


Betrifft: worksheet change 2 Subs zusammenführen von: Jan
Geschrieben am: 16.12.2009 12:30:12

Liebe Excelianer,

ich habe hier diesen hübschen Code in zwei Subs, den ich wohl in eine zusammenfügen muss, da die Worksheet_change funktion scheinbar nur einmal verwendet werden kann. Eigentlich müsste ich die Funktion viermal anwenden, da ich vier Spalten "behandeln" möchte. Alle meine Versuche und Basteleien waren bisher von Misserfolg gekrönt - Kann mir jemand einen Tipp hinsichtlich Deklaration und Umsetzung geben?

Zu Erläuterung: Die Funktion schreibt den Wert aus Spalte x in Spalte y, wenn Eintrag x erfolgt. Falls x wieder gelöscht wird, wird wieder eine Formel eingesetzt.

Besten Gruß,
Jan

Private Sub Worksheet_Change1(ByVal Target As Range)

If Target.Column <> 13 Then Exit Sub
If Cells(Target.Row, 13) > 0 Then
Cells(Target.Row, 11) = Target
End If
If Cells(Target.Row, 13) = 0 Then
Cells(Target.Row, 11).FormulaR1C1 = "=RC[-4] * RC[-5]"

End If
End Sub
Private Sub Worksheet_Change2(ByVal Target As Range)

If Target.Column <> 24 Then Exit Sub
If Cells(Target.Row, 22) > 0 Then
Cells(Target.Row, 22) = Target
End If
If Cells(Target.Row, 24) = 0 Then
Cells(Target.Row, 22).FormulaR1C1 = "=RC[-4] * RC[-5]"

End If
End Sub

  

Betrifft: AW: worksheet change 2 Subs zusammenführen von: Jens
Geschrieben am: 16.12.2009 14:27:04

Hallo Jan

ungetestet:

Private Sub Worksheet_Change1(ByVal Target As Range)

Select Case Target.Column
Case Is = 13
If Cells(Target.Row, 13) > 0 Then
Cells(Target.Row, 11) = Target
End If
If Cells(Target.Row, 13) = 0 Then
Cells(Target.Row, 11).FormulaR1C1 = "=RC[-4] * RC[-5]"
End If

Case Is = 24
If Cells(Target.Row, 22) > 0 Then
Cells(Target.Row, 22) = Target
End If
If Cells(Target.Row, 24) = 0 Then
Cells(Target.Row, 22).FormulaR1C1 = "=RC[-4] * RC[-5]"
End If

Case Else
Exit Sub

End Select

End Sub
Gruß Jens

PS: Die Case-Anweisung kannst Du beliebig erweitern.


  

Betrifft: Falsche syntax von: F1
Geschrieben am: 16.12.2009 15:13:28

Private Sub Worksheet_Change1(ByVal Target As Range)

gibt es so nicht!


  

Betrifft: Er hat auch den anderen Fehler mit übernommen... von: Luc:-?
Geschrieben am: 16.12.2009 15:21:15

...- wäre mir auch beinahe passiert... ;-)
Gruß Luc :-?


  

Betrifft: Stimmt natürlich... von: Jens
Geschrieben am: 16.12.2009 15:43:15

Hi

Hab ich glatt übersehen. Muss natürlich

Private Sub Worksheet_Change(ByVal Target As Range)

heißen (ohne die 1).

Danke für den Hinweis.

Gruß Jens


  

Betrifft: Da es sich hier quasi um analoge Prozz... von: Luc:-?
Geschrieben am: 16.12.2009 14:51:36

...handelt, Jan,
lassen die sich leicht wie folgt zusammenführen (abgesehen mal davon, dass ich das eigentl Pgm in eine „normale“ Proz auslagern und die Ereignisproz nur als Verteiler benutzen würde — bereitet weniger Probleme bei Erweiterungen!)...

Private Sub Worksheet_Change(ByVal Target As Range)
    Const AZielSpVg As String = "13 24 ...", _
          EZielSpVg As String = "11 22 ..."    '... durch die and Spp ersetzen!
    Dim i As Integer, ZielSp As Long, AZielSpp, EZielSpp As Variant
    On Error Resume Next
    AZielSpp = Split(AZielSpVg, " "): EZielSpp = Split(EZielSpVg, " ")
    If IsError(WorksheetFunction.Match(CStr(Target.Column), AZielSpp, 0)) Then _
        Exit Sub
    For Each ZielSp In AZielSpp
        If Cells(Target.Row, ZielSp) <= 0 Then 
            Cells(Target.Row, EZielSpp(i)).FormulaR1C1 = "=RC[-4] * RC[-5]"
        Else: Cells(Target.Row, EZielSpp(i)) = Target
        End If
        i = i + 1
    Next ZielSp
End Sub

...vorausgesetzt, die 22 in Proz2 If Cells(Target.Row, 22) > 0 Then ist nur ein Schreibfehler (machte sonst ja auch keinen Sinn).
Wären es grdverschiedene Prozz würde ich auf die Sekundär-Proz-Möglichkeit beim Workbook (ggf auch Tertiär-Möglichkeit bei der Application — mehr ist dann wirklich nicht!) verweisen oder hätte mehr Arbeit gehabt... ;-)
Apropos Arbeit! Unter gewissen Voraussetzungen (Existenz einer entsprechenden udFkt) kann man den For Each-Zyklus auch wie folgt schreiben...
    For Each ZielSp In Pair(AZielSpp, EZielSpp)
        If Cells(Target.Row, ZielSp(0)) <= 0 Then 
            Cells(Target.Row, ZielSp(1)).FormulaR1C1 = "=RC[-4] * RC[-5]"
        Else: Cells(Target.Row, ZielSp(1)) = Target
        End If
    Next ZielSp

Die Variable i wird dann hier nicht benötigt.
Gruß Luc :-?


  

Betrifft: PS: Seelect Case reicht natürlich völlig,... von: Luc:-?
Geschrieben am: 16.12.2009 14:55:33

...Jan & Jens,
sonst rödelt das nur unnötig alles durch, obwohl es ja immer nur eine geben kann... ;-)
Aber viell nutzt dir das anderweitig was...
Gruß Luc :-?


  

Betrifft: ...bzw ein ': Exit For' nach jd Zellfüllaktion owT von: Luc:-?
Geschrieben am: 16.12.2009 15:23:59

:-?


  

Betrifft: sieht gut aus von: Jan
Geschrieben am: 16.12.2009 15:27:59

Hey Jungs, das sieht schon richtig gut aus. Komme heute leider nicht mehr zum ausprobieren. Das muss bis morgen warten. Ich melde mich hier wieder,

beste Grüße und herzlichen Dank, Jan


Beiträge aus den Excel-Beispielen zum Thema "worksheet change 2 Subs zusammenführen"