Anzeige
Archiv - Navigation
1064to1068
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro bei drop down (Intersect)

Makro bei drop down (Intersect)
30.03.2009 10:26:43
Ryu
Guten Morgen zusammen! Ich habe zwei Probleme bei folgendem Makro. Ich habe zwei Zellen mit dropdown Feldern. Nachdem ich dort einen anderen Eintrag ausgewählt habe, soll was bestimmtes passieren.
Problem 1) Wenn ich den code so lasse wie unten angegeben funktioniert das erste intersect mit Zelle "D5", aber das zweite nicht. Warum? Wie kann ich beides zum laufen bringen?
Problem 2) Wenn ich das erste Intersect deaktiviere wird das zweite ausgeführt allerdings kopiert es mir die falschen Daten. Es sind nicht die Zeilen an der Stelle i sondern er fängt von ganz Anfang an... Sieht jemand woran es liegt?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim zähler As Integer
Dim letzteZelle As Range
Application.ScreenUpdating = False
Set letzteZelle = Worksheets("F").Range("A2").End(xlDown)
If Intersect(Target, Range("D5")) Is Nothing Then Exit Sub
Range("D9").ClearContents
If Intersect(Target, Range("D9")) Is Nothing Then Exit Sub
zähler = 1
For i = 2 To letzteZelle.Row
If Trim(Worksheets("F").Cells(i, 2).Value) = Trim(Range("D9").Value) Then
zähler = zähler + 1
Worksheets("F").Rows(i).Copy Destination:=Worksheets("Daten").Cells(zähler, 1)
End If
Next i
Application.ScreenUpdating = True
End Sub


Ich danke in voraus für alle Tips
Grüße

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro bei drop down (Intersect)
30.03.2009 10:53:37
fcs
Hallo Ryu,
Problem 1:
Du darfs die 1. Bedingung natürlich nicht mit Exit Sub beenden, wenn sie nicht erüllt wird. So wird die 2. Bedingungung garnicht geprüft.
Problem 2: Während der Code ausführung sollten die Ereignismakros deaktiviert sein, damit der Code ggf. nicht imer neu gestartet wird.
Gruß
Franz
Angepasster Code, ungetestet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim zähler As Integer
Dim letzteZelle As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Set letzteZelle = Worksheets("F").Range("A2").End(xlDown)
If Not Intersect(Target, Range("D5")) Is Nothing And Target.Cells.Count = 1 Then
Range("D9").ClearContents
End If
If Not Intersect(Target, Range("D9")) Is Nothing And Target.Cells.Count = 1 Then
zähler = 1
For i = 2 To letzteZelle.Row
If Trim(Worksheets("F").Cells(i, 2).Value) = Trim(Range("D9").Value) Then
zähler = zähler + 1
Worksheets("F").Rows(i).Copy Destination:=Worksheets("Daten").Cells(zähler, 1)
End If
Next i
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Makro bei drop down (Intersect)
30.03.2009 11:54:36
Ryu
Hallo Franz!
Das erste Problem hast du erfolgreich gelöst, allerdings funktioniert das zweite immer noch nicht :( Er kopiert die Zellen beginnend ab Zeile 2 die Anzahl an Zellen wo Wert D9=Wert Spalte B.
AW: Makro bei drop down (Intersect)
30.03.2009 13:33:02
fcs
Hallo Ryu,
wenn der Zähler im Blatt Daten immer mit der letzten Datenzeile beginnen soll, dann muss du diesen vor der For-Next-Schleife etwa wie folgt bestimmen.

With Worksheets("Daten")
'letzte Zeile mit Daten in Spalte 1 (A)
zähler = .Cells(.Rows.Count, 1).End(xlUp).Row
End With


Als Spalte für die Berechnung der Zeile muss du eine Spalte wählen, in der immer ein Wert eingetragen ist!
Falls keine solche Spalte vorhanden ist, dann muss man die letzte Datenzeile in eienr Schleife ermitteln, die alle Datenspalten abarbeitet und den Max-Wert der Zeile bestimmt.
Gruß
Franz

Anzeige
AW: Makro bei drop down (Intersect)
30.03.2009 13:58:19
Ryu
Hallo Franz danke für deinen Tip. Allerdings hast du falsch verstanden wozu der zähler dient.
Wenn ich den zähler weglasse und bei Kopierpfad "i" statt zähler angebe
Worksheets("F").Rows(i).Copy Destination:=Worksheets("Daten").Cells(i, 1)
kopiert er mir die Daten wie gewünscht allerdings in die Zeilen wo es ursprünglich war. d.h. wenn es Zeilen 100 bis 130 drin war, ist bis Zeile 100 alles leer und dann 100-130 mit Daten und Rest leer. Ich möchte jedoch dass die Daten in Blatt Daten ab Spalte 2 anfangen. So wie es momentan ist kopiert er ja die richtige Anzahl der Zeilen beginnend in Zeile 2 nur dass er die falschen Zeilen kopiert!!!
Der Zähler soll dazu dienen dass immer wenn die Bedingung erfüllt ist die entsprechende Zeile untereinander beginnend in Splalte 2 kopiert wird.
Ich hoffe dies hilft dir/anderen weiter
Anzeige
AW: Makro bei drop down (Intersect)
30.03.2009 14:28:47
fcs
Hallo Ryu,
deine Erklärung ist immer noch ein wenig verwirrend.
Aber Excel kann kopierte Zeilen immer nur als ganze Zeilen wieder einfügen.
Wenn Du die Daten im Blatt "Daten" erst ab der 2. Spalte einfügen willst, dann darfs du nicht die gesamte Zeile Kopieren und Einfügen, sondern nur einige Zellen aus der Zeile.
Beispiel:

If Not Intersect(Target, Range("D9")) Is Nothing And Target.Cells.Count = 1 Then
zähler = 1
For i = 2 To letzteZelle.Row
If Trim(Worksheets("F").Cells(i, 2).Value) = Trim(Range("D9").Value) Then
zähler = zähler + 1
'Werte aus Spalte 1 bis 10 (A bis J) nach Spalte 2 bis 11 (B bis K) in "Daten" kopieren
With Worksheets("F")
.Range(.Cells(i, 1), .Cells(i, 10)).Copy _
Destination:=Worksheets("Daten").Cells(zähler, 2)
End With
End If
Next i
End If


Gruß
Franz

Anzeige
AW: Makro bei drop down (Intersect)
30.03.2009 15:51:27
Ryu
Hallo Franz,
Sorry für die Verwirrung. Was genau verstehst du nicht, was soll ich genau erläutern? Ich habe diesen code getestet, leider kopiert auch hier nicht die richtigen Zellen. :(( Ich bin am verzweifeln.
AW: Makro bei drop down (Intersect)
30.03.2009 18:12:27
fcs
Hallo Ryu,
ich verstehe den Ablauf folgendermaßen und so funktioniert er auch in meiner Testdatei.
1. in Zelle D9 des Blattes wird ein Text eingegeben.
Im Blatt "F" wird
2. ausgehend von Zelle A2 nach unten die letzte Zelle mit Daten ermittelt.
3. in der For-Next-Schleife mit Zähler i=2 bis zu der in Schritt 2 ermittelten Zeile
3.1 in jeder Zeile der Wert in Spalte 2 mit dem Wert in D9 verglichen
3.2 bei Übereinstimmumg der Zeilenzähler für das Blatt "Daten" um 1 erhöht und
3.3 die Zellen A bis J der Zeile i aus dem Blatt "F" in die Zeile Zähler des Blatts "Daten"
in Zellen B bis K kopiert.
Wenn du es anders haben willst, dann beschreibe in genau sollchen Schritten, was passieren soll und lade hier auch am besten eine Beispieldatei mit ein paar neutralisierten Daten hoch. Sonst stochern wir hier noch ewig im Nebel.
Gruß
Franz
Anzeige
AW: Makro bei drop down (Intersect)
31.03.2009 10:26:53
Ryu
Guten Morgen,
ich hatte dir gerade ein Muster vorbereitet und dabei bin ich auf den Kern des Problems gestossen. Ich habe erkannt dass wenn ich die Daten in Blatt "F" festetze (diese sind mit Daten in anderen Datei verknüpft um stets mit aktuellen Zahlen zu arbeiten), dann läuft der Makro ohne Probleme (und deutlich schneller) und richtig. Wenn es jedoch als Verknüpfung bleibt statt absoluten Zahlen, sind die Daten falsch.
Muss ich nun die Daten fest setzen oder gibt es dafür eine Lösung?
Gruss
AW: Makro bei drop down (Intersect)
31.03.2009 10:42:30
fcs
Hallo Ryu,
wenn du im Blatt "Daten" nur die Daten -ohne Verknüpfung- benötigst, dann kann man auch nur die Werte und Formate im Blatt "Daten" einfügen statt der Formeln.
Gruß
Franz

If Not Intersect(Target, Range("D9")) Is Nothing And Target.Cells.Count = 1 Then
zähler = 1
For i = 2 To letzteZelle.Row
If Trim(Worksheets("F").Cells(i, 2).Value) = Trim(Range("D9").Value) Then
zähler = zähler + 1
'Werte aus Spalte 1 bis 10 (A bis J) nach Spalte 2 bis 11 (B bis K) in "Daten"  _
kopieren
With Worksheets("F")
.Range(.Cells(i, 1), .Cells(i, 10)).Copy
Worksheets("Daten").Cells(zähler, 2).PasteSpecial Paste:=xlFormats
Worksheets("Daten").Cells(zähler, 2).PasteSpecial Paste:=xlValues
End With
End If
Next i
Application.CutCopyMode = False
End If


Anzeige
AW: Makro bei drop down (Intersect)
31.03.2009 11:37:12
Ryu
Danke! Damit ist das Problem gelöst!

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige