vorhandenes Makro anpassen, Abfragebereich ändern

[Dietmar65]

Hallo liebe Gemeinde, 

ich habe ein kleines Problem, zumindest für die Excel-Freunde hier ist es ein kleines Problem, denke ich. Im Verein Nutzen wir einen Turnierplan, den ich gern überarbeiten möchte. 

Ich habe einen Code welcher auf die Zeile A1 (Blatt1) ohne Probleme funktioniert, auf dem Blatt "Torschützen" werden diese Nacheinander aufgezählt: 

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address(0, 0) = "A1" Then
   If Target <> "" Then
     Application.EnableEvents = False
     If Worksheets("Torschützen").Range("A1") = "" Then
       Worksheets("Torschützen").Range("A1") = Target
       Target = ""
     Else
       Worksheets("Torschützen").Range("A1")(Worksheets("Torschützen").Range("A1")(Rows.Count, 1).End(xlUp).Row + 1, 1) = Target
       Target = ""
     End If
     Target.Select
     Application.EnableEvents = True
   End If
 End If
End Sub

Jetzt würde ich gern das "A1" erweitern auf bis zu 150 weitere Felder.  Nun meine Frage: 

Ist es möglich den Eingabebereich zu vergrößern, oder muss ich die Formel 150 mal (je Heim/Auswärts) schreiben mit jeweils einer anderen Adressierung? 

Anbei ist auch noch die Testdatei.


  Torschützen.xlsm (Größe: 35,61 KB / Downloads: 4)

Recht herzlichen Dank für Ihre Hilfe. 

Beste Grüße

Didi

[Fennek]

Hallo,

Ungeprüft

Wenn der zu überwachende Bereich als 'set r = Range("A1:A50") ' (oder beliebig) definiert ist,

Kann mit 

Code:

If intersect(target, r) then

der gesamten Bereiche überwacht werden.
Oft wird auch die Negation genutzt:
If not intersect(...) then exit sub
Mfg

[Steffl]

Auch Hallo,

du willst die Werte im Worksheet Torschützen immer in der Zelle A1 eintragen?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A150")) Is Nothing Then
   If Target.Cells(1) <> "" Then
     Application.EnableEvents = False
     If Worksheets("Torschützen").Range("A1") = "" Then
       Worksheets("Torschützen").Range("A1") = Target
       Target = ""
     Else
       Worksheets("Torschützen").Range("A1")(Worksheets("Torschützen").Range("A1")(Rows.Count, 1).End(xlUp).Row + 1, 1) = Target
       Target = ""
     End If
     Target.Select
     Application.EnableEvents = True
   End If
End If
End Sub

[Dietmar65]

Recht herzlichen Dank für die schnelle Unterstützung.   :19:

@Stefan: Nein, es soll nicht nur A1 abgefragt werden. In diesem Fall A1:A150, so wie du es umgebaut hast. Vorher hat es ja funktioniert, mit der Abfrage einer einzelnen Zelle. 


Nochmals danke und ein schönes Wochenende. 

Gruß 
Didi

[Dietmar65]

Auch Hallo,

du willst die Werte im Worksheet Torschützen immer in der Zelle A1 eintragen?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A150")) Is Nothing Then
  If Target.Cells(1) <> "" Then
    Application.EnableEvents = False
    If Worksheets("Torschützen").Range("A1") = "" Then
      Worksheets("Torschützen").Range("A1") = Target
      Target = ""
    Else
      Worksheets("Torschützen").Range("A1")(Worksheets("Torschützen").Range("A1")(Rows.Count, 1).End(xlUp).Row + 1, 1) = Target
      Target = ""
    End If
    Target.Select
    Application.EnableEvents = True
  End If
End If
End Sub

Hallo, 

eine Frage hätte ich doch noch. Ist es auch möglich etwas einzufügen was dafür zuständig ist, das Ergebnis zu aktualisieren, wenn ich einen Torschützen eintrage? 

Sprich: 
Wenn ich z.B. bei J4 den Torschützen eintrage, dass dann F4 automatisch +1 gerechnet wird?

Ich bedanke mich schon mal im Voraus.  :19:

Gruß Didi


  Torschützen.xlsm (Größe: 38,34 KB / Downloads: 2)

[Steffl]

Hallo,

meinst Du so?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J4:J6,L4:L6")) Is Nothing Then
   If Target.Cells(1) <> "" Then
     Application.EnableEvents = False
     Target.Offset(, -4) = Target.Offset(, -4) + 1
     If Worksheets("Torschützen").Range("A1") = "" Then
       Worksheets("Torschützen").Range("A1") = Target
       Target = ""
     Else
       Worksheets("Torschützen").Range("A1")(Worksheets("Torschützen").Range("A1")(Rows.Count, 1).End(xlUp).Row + 1, 1) = Target
       Target = ""
     End If
     Target.Select
     Application.EnableEvents = True
   End If
End If
End Sub