VBA - Automatische Aktualisierung nur für definierten Bereich

[Sebbo]

Hallo zusammen,

ich habe schon wieder eine Frage bei welcher ich nicht weiter komme (ja ich bastel gerade viel in Excel :19: ) und Dr. Google war mir keine Hilfe.

Ich habe in einer Excel Datei zwei Tabellenblätter. In dem zweiten Blatt sind Namen von Trainern und Spielern hinterlegt.

In dem ersten Blatt möchte ich nun das er mir nach Auswahl eines Teams in Spalte "L" die zugehörigen Namen der Trainer und Spieler in derselben Zeile hintereinander auflistet. Das funktioniert auch erst mal.

Nun ist es aber so, dass wenn ich in einer Zeile in Spalte "L" eine Änderung vornehme, er mir nicht nur die betreffende Zeile aktualisiert, sondern den kompletten Zellbereich.

Die Frage ist, wie ich Excel beibringen kann, dass es ausschließlich nur die Zeile ändert, in welcher ich auch eine Änderung vornehme.

Ich hoffe ich habe es halbwegs verständlich erklären können. Ich habe zum besseren Verständnis mal eine Beispieldatei mit dem entsprechenden Code angehängt.

Für einen Tipp wäre ich sehr dankbar.

Und noch eine weitere Frage:

Ich möchte zusätzlich, dass Excel mir in dem Beispiel File die komplette jeweilige Zeile löscht, wenn ich in Spalte L in einer Zelle den Inhalt lösche. Mein Code dazu sieht aktuell so aus:

Code:

Dim j As Integer
For j = 28 To 47
If Worksheets("Planning").Cells(j, 12) = "" And Worksheets("Planning").Cells(j, 13) <> "" Then
Worksheets("Planning").Cells(j, 13).ClearContents
End If
If Worksheets("Planning").Cells(j, 12) = "" And Worksheets("Planning").Cells(j, 14) <> "" Then
Worksheets("Planning").Cells(j, 14).ClearContents
End If
If Worksheets("Planning").Cells(j, 12) = "" And Worksheets("Planning").Cells(j, 15) <> "" Then
Worksheets("Planning").Cells(j, 15).ClearContents
End If
If Worksheets("Planning").Cells(j, 12) = "" And Worksheets("Planning").Cells(j, 16) <> "" Then
Worksheets("Planning").Cells(j, 16).ClearContents
End If
If Worksheets("Planning").Cells(j, 12) = "" And Worksheets("Planning").Cells(j, 17) <> "" Then
Worksheets("Planning").Cells(j, 17).ClearContents
End If
If Worksheets("Planning").Cells(j, 12) = "" And Worksheets("Planning").Cells(j, 18) <> "" Then
Worksheets("Planning").Cells(j, 18).ClearContents
End If
Next

Auch hier wäre ich aus Neugierde für ein Feedback dankbar, ob es da eine einfachere Möglichkeit gibt

Viele Grüße

Sebbo

[Raoul21]

Hi
mal ganz auf die Schnelle: In Deiner Beispielmappe ändere 2 Zeilen:

Code:

For a = target.Row To target.Row

und

Code:

For j = target.Row To target.Row

Dann sollte es funktionieren.

Diese Änderung hat einen sehr geringen Änderungsaufwand. Elegant ist anders, aber es funktioniert.

Das ganze Makro kann man auch viel einfacher schreiben, aber nicht von mir zu dieser Nachtzeit.

Bitte schreibe einen Code in das dafür vorgesehene Fenster. Dieses kannst Du durch Klicken auf das 5. Symbol von rechts hier im Texteingabefenster öffnen. Oder Du markierst den Code und drückst dann auf dieses Symbol.

GN, Raoul

[Sebbo]

Hi Raoul,

super, vielen Dank für deine Hilfe! Ich habe es eben mit der von dir vorgeschlagenen Änderung ausprobiert, es funktioniert genau wie es soll!
Gut, das Makro ist dank meiner begrenzten Kenntnisse vielleicht wirklich etwas umständlich, aber solange es das macht was es soll bin ich erst mal zufrieden :19:

Danke auch für den Hinweis mit dem "Code-Fenster". Das wusste ich nicht, werde es aber bei weiteren Fragen (die bestimmt noch kommen  :19: ) berücksichtigen.

Viele Grüße
Sebbo

[Raoul21]

Jetzt ist Dein Code ja in einem Fenster. Hast Du das nachträglich gemacht? Oder waren da geheime Kräfte im Spiel?

Übrigens: Du könntest auch die Funktion SVerweis verwenden. In M28:
=SVERWEIS($L28;'Team Data'!$V$6:$AB$27;3;FALSCH)
Das dann nach rechts kopieren und die 3 korrigieren, dann alles runter kopieren.

Doch zuerst: Das Makro "Worksheet_Change" stillegen. Denn die überschreibt sofort die Formeln.

[WillWissen]

Hi Raoul,

Jetzt ist Dein Code ja in einem Fenster. Hast Du das nachträglich gemacht? Oder waren da geheime Kräfte im Spiel?

das waren die Heinzelmännchen. Noch bekannt? :89:


Oder:     

[Raoul21]

Folgendes Makro gehört in das Blatt Tabelle1 und soll das bestehende Worksheet_Change ersetzen.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Planung As Range, TeamDaten As Range
   Dim Team As Range
   Application.EnableEvents = False
   Set Planung = Range("L27:R47")
   Set TeamDaten = Worksheets("Team Data").Range("V6").CurrentRegion
   If Not Intersect(Target, Planung.Columns(1)) Is Nothing Then
      If Target = "" Then
         Intersect(Target.EntireRow, Planung).ClearContents
      Else
         Set Team = TeamDaten.Columns(1).Find(Target, LookIn:=xlValues, lookat:=xlWhole)
         Planung(Target.Row - Planung.Row + 1, 2).Resize(, 5) = Team.Offset(, 2).Resize(, 5).Value
         Planung(Target.Row - Planung.Row + 1, 7) = Team.Offset(, 1).Value
      End If
   End If
   Application.EnableEvents = True
End Sub

Nun wird die Zeile ausgefüllt gemäß Eintrag in Spalte L. Wird die Teamnummer gelösct, wird die ganze Teamzeile gelöscht.
Studier und probier.
LG, Raoul

[Raoul21]

Hallo Sebbo,

meine beiden Alternativlösungen, die ich nachgeschoben habe, Formel (Beitrag #4) und Makro (#6), sind ja nur falls Du mit der Hauptlösung (#2) nicht klar kommst. Ich hoffe, Du bist daran nicht verzweifelt, weil irgend etwas nicht funktioniert.

Gruss, Raoul