Supportnet / Forum / Tabellenkalkulation
Makro Code verbessern
Frage
Hallo Excelspezialisten,
ich habe ein Makro, das aus einer Tabelle (MW) nach einem Autofilter Werte kopiert und in eine andere (Auswerten) überträgt. Da der Kopiervorgang zweimal (verschiedene Zeilen) durchgeführt wird, werden immer wieder die Ansichten (Sheets("MW").Select) gewechselt.
Kann man verhindern, das die Tabelle (Auswerten) auch immer wieder kurz angezeigt wird?
Ich hoffe ihr habt dazu eine Lösung!
Gruß
fedjo
Sub Mittelwert()
Sheets("MW").Range("B5:B65536").Cells.SpecialCells(xlCellTypeVisible)(1).Copy ´findet die fünfte Zelle in B
Sheets("Auswerten").Select
Range("A65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
ActiveSheet.Paste
Sheets("MW").Range("E2:J2").Copy
Sheets("Auswerten").Select
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A2:G500").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("MW").Select
End Sub
Antwort 1 von Beverly
Hi Fedjo,
ich habe mir jetzt nicht deinen Code angeschaut, da ich den Aufbau deiner Arbeitsmappe nicht kenne, sondern bin einfach mal nach der Beschreibung deiner Aufgabenstellung gegangen
Kopiert wird aus Tabelle1 Spalten E:J der mit Autofilter gefilterten Zeilen nach Tabelle2 beginnend ab Zelle A1. Vielleicht hilft dir dieser Code als Ansatz weiter.
Bis später,
Karin
ich habe mir jetzt nicht deinen Code angeschaut, da ich den Aufbau deiner Arbeitsmappe nicht kenne, sondern bin einfach mal nach der Beschreibung deiner Aufgabenstellung gegangen
Sub kopieren()
Dim loZeile As Long ´ Zeilenzähler für Schleife
Dim loLetzte As Long ´ letzte belegte Zelle
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
´ letzte belegte Zelle in Spalte B als Endwert für die Schleife
loLetzte = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count)
For loZeile = 1 To loLetzte
´ nur die sichtbaren Zeilen
If .Cells(loZeile, 1).EntireRow.Hidden = False Then _
.Range("E1:J" & loZeile).Copy Worksheets("Tabelle2").Range("A1")
Next loZeile
End With
Application.ScreenUpdating = True
End Sub
Kopiert wird aus Tabelle1 Spalten E:J der mit Autofilter gefilterten Zeilen nach Tabelle2 beginnend ab Zelle A1. Vielleicht hilft dir dieser Code als Ansatz weiter.
Bis später,
Karin
Antwort 2 von fedjo
Hallo Karin,
Danke für die Hilfe!!!!
Ich habe die Tabelle hochgeladen:
http://www.netupload.de/detail.php?img=a919ef58826c60e30502dff4dd95...
Erklärung:
Tabelle (MW) Autofilter (B4)
Erste sichtbare Zelle nach Autofilter (Lieferant) kopieren.
Tabelle (Auswerten) erste leere Zelle in A finden u. einfügen.
Tabelle (MW) E2:J2 kopieren u. Tabelle (Auswerten) erste leer Zelle in B finden u. einfügen.
Tabelle (Auswerten) sortieren nach Spalte A Lieferant.
Tabelle (MW)
Gruß
fedjo
Danke für die Hilfe!!!!
Ich habe die Tabelle hochgeladen:
http://www.netupload.de/detail.php?img=a919ef58826c60e30502dff4dd95...
Erklärung:
Tabelle (MW) Autofilter (B4)
Erste sichtbare Zelle nach Autofilter (Lieferant) kopieren.
Tabelle (Auswerten) erste leere Zelle in A finden u. einfügen.
Tabelle (MW) E2:J2 kopieren u. Tabelle (Auswerten) erste leer Zelle in B finden u. einfügen.
Tabelle (Auswerten) sortieren nach Spalte A Lieferant.
Tabelle (MW)
Gruß
fedjo
Antwort 3 von fedjo
Hallo Karin,
ich habe in den Cote
und dadurch ereicht das die Ansichten nicht mehr wechseln.
Könnte man den Ablauf des Makros nicht automatisieren und die Tabelle auswerten bis zum Ende der Einträge im Autofilter?
Gruß
fedjo
Sub Mittelwert()
Application.ScreenUpdating = False
Sheets("MW").Range("B5:B65536").Cells.SpecialCells(xlCellTypeVisible)(1).Copy
Sheets("Auswerten").Select
Range("A65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
ActiveSheet.Paste
Sheets("MW").Range("E2:J2").Copy
Sheets("Auswerten").Select
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A2:G500").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("MW").Select
End Sub
ich habe in den Cote
Zitat:
Application.ScreenUpdating = False
eingefügt,Application.ScreenUpdating = False
und dadurch ereicht das die Ansichten nicht mehr wechseln.
Könnte man den Ablauf des Makros nicht automatisieren und die Tabelle auswerten bis zum Ende der Einträge im Autofilter?
Gruß
fedjo
Sub Mittelwert()
Application.ScreenUpdating = False
Sheets("MW").Range("B5:B65536").Cells.SpecialCells(xlCellTypeVisible)(1).Copy
Sheets("Auswerten").Select
Range("A65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
ActiveSheet.Paste
Sheets("MW").Range("E2:J2").Copy
Sheets("Auswerten").Select
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A2:G500").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("MW").Select
End Sub
Antwort 4 von Beverly
Hi Fedjo,
ich habe erst einmal deinen ersten Code ein wenig umgeschreiben. Auch wenn du die Bildschirmaktualisierung ausschaltest, verlangsamen alle Select und Activate den Code z.T. wesentlich. Deshalb sollte man nach Möglichkeit darauf verzichten und zu 99% kann man das auch
Deine neuerliche Frage verstehe ich nicht ganz. Wenn ich das richtig gesehen habe, gibt es jeden Lieferanten nur ein Mal, weshalb dann "bis zum Ende des Autofilters"? Es wird doch immer nur einer angezeigt.
Bis später,
Karin
ich habe erst einmal deinen ersten Code ein wenig umgeschreiben. Auch wenn du die Bildschirmaktualisierung ausschaltest, verlangsamen alle Select und Activate den Code z.T. wesentlich. Deshalb sollte man nach Möglichkeit darauf verzichten und zu 99% kann man das auch
Sub Mittelwert()
Dim loLetzte As Long
Dim loZeile As Long
loLetzte = IIf(IsEmpty(Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5)), Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5).End(xlUp).Row, Worksheets("Auswerten").Rows.Count)
With Worksheets("MW")
loZeile = .Range("B5:B65536").Cells.SpecialCells(xlCellTypeVisible)(1).Row ´.Copy
Union(.Range("B" & loZeile), .Range("E" & loZeile & ":J" & loZeile)).Copy Worksheets("Auswerten").Cells(loLetzte + 1, 1)
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 5)), .Cells(.Rows.Count, 5).End(xlUp).Row, .Rows.Count)
.Range("A2:G" & loLetzte).Sort Key1:=Range("A2"), Header:=xlYes
End With
End Sub
Deine neuerliche Frage verstehe ich nicht ganz. Wenn ich das richtig gesehen habe, gibt es jeden Lieferanten nur ein Mal, weshalb dann "bis zum Ende des Autofilters"? Es wird doch immer nur einer angezeigt.
Bis später,
Karin
Antwort 5 von fedjo
Hallo Karin,
die Zeile
Der Autofilter sollte automatisch durchlaufen, und die gefilterten Werte (MW u. Lieferant) in die Tabelle (Auswerten) übertragen werden.
Gruß
fedjo
die Zeile
Zitat:
loZeile = .Range("B5:B65536").Cells.SpecialCells(xlCellTypeVisible)(1).Row ´.Copy
wird rot angzeigt.loZeile = .Range("B5:B65536").Cells.SpecialCells(xlCellTypeVisible)(1).Row ´.Copy
Der Autofilter sollte automatisch durchlaufen, und die gefilterten Werte (MW u. Lieferant) in die Tabelle (Auswerten) übertragen werden.
Gruß
fedjo
Antwort 6 von Beverly
Hi Fedjo,
der Teil hinter .Row ist der auskommentierte Teil deines Ursprungscodes und der Apostroph wird häufig beim Kopieren aus dem Forum falsch übertragen.
Hier der erweiterte Code
Bis später,
Karin
der Teil hinter .Row ist der auskommentierte Teil deines Ursprungscodes und der Apostroph wird häufig beim Kopieren aus dem Forum falsch übertragen.
Hier der erweiterte Code
Sub Mittelwert()
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim loZeile As Long
Application.ScreenUpdating = False
loLetzte2 = IIf(IsEmpty(Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5)), Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5).End(xlUp).Row, Worksheets("Auswerten").Rows.Count)
With Worksheets("MW")
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For loZeile = 5 To loLetzte1
If .Cells(loZeile, 1).EntireRow.Hidden = False Then
loLetzte2 = loLetzte2 + 1
Union(.Range("B" & loZeile), .Range("E" & loZeile & ":J" & loZeile)).Copy Worksheets("Auswerten").Cells(loLetzte2, 1)
End If
Next loZeile
End With
Worksheets("Auswerten").Activate
With ActiveSheet
loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 5)), .Cells(.Rows.Count, 5).End(xlUp).Row, .Rows.Count)
.Range("A2:G" & loLetzte2).Sort Key1:=Range("A2"), Header:=xlYes
End With
Worksheets("MW").Activate
Application.ScreenUpdating = True
End Sub
Bis später,
Karin
Antwort 7 von fedjo
Hallo Karin,
Danke für die Antwort!
Es werden aber andere Werte übertragen.
Übertragungswerte Tabelle (MW):
Autofilter Lieferant (B4) erst gefüllte Zelle
Werte aus E2:J2 (Funktionen)
Gruß
fedjo
Danke für die Antwort!
Es werden aber andere Werte übertragen.
Übertragungswerte Tabelle (MW):
Autofilter Lieferant (B4) erst gefüllte Zelle
Werte aus E2:J2 (Funktionen)
Gruß
fedjo
Antwort 8 von Beverly
Hi Fedjo,
Es war ein Fehler beim Ermitteln der letzten belegten Zelle, da ich in der falschen Spalte habe suchen lassen. Jetzt sollte es funktionieren.
Noch einen Tipp: lösche alle Zeilen unterhalb deiner letzten Eingabe. Irgendwo befinden sich noch Steuerzeichen in der Tabelle, die sie so nutzlos umfangreich macht. Kannst diesen Code verwenden
Bis später,
Karin
Sub Mittelwert()
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim loZeile As Long
Application.ScreenUpdating = False
loLetzte2 = IIf(IsEmpty(Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 1)), Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 1).End(xlUp).Row, Worksheets("Auswerten").Rows.Count)
With Worksheets("MW")
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For loZeile = 5 To loLetzte1
If .Cells(loZeile, 1).EntireRow.Hidden = False Then
loLetzte2 = loLetzte2 + 1
Union(.Range("B" & loZeile), .Range("E" & loZeile & ":J" & loZeile)).Copy Worksheets("Auswerten").Cells(loLetzte2, 1)
End If
Next loZeile
End With
Worksheets("Auswerten").Activate
With ActiveSheet
loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
.Range("A2:G" & loLetzte2).Sort Key1:=Range("A2"), Header:=xlYes
End With
Worksheets("MW").Activate
Application.ScreenUpdating = False
End Sub
Es war ein Fehler beim Ermitteln der letzten belegten Zelle, da ich in der falschen Spalte habe suchen lassen. Jetzt sollte es funktionieren.
Noch einen Tipp: lösche alle Zeilen unterhalb deiner letzten Eingabe. Irgendwo befinden sich noch Steuerzeichen in der Tabelle, die sie so nutzlos umfangreich macht. Kannst diesen Code verwenden
Sub loeschen()
Range("A61:IV65536").EntireRow.Delete
End Sub
Bis später,
Karin
Antwort 9 von fedjo
Hallo Karin,
es werden mehrere Einträge vom einem Lieferanten (Föhl) übertragen.
Gruß
fedjo
es werden mehrere Einträge vom einem Lieferanten (Föhl) übertragen.
Zitat:
Übertragungswerte Tabelle (MW):
Autofilter Lieferant (B4) erst gefüllte Zelle
Werte aus E2:J2 (Funktionen)
Übertragungswerte Tabelle (MW):
Autofilter Lieferant (B4) erst gefüllte Zelle
Werte aus E2:J2 (Funktionen)
Gruß
fedjo
Antwort 10 von Beverly
Hi Fedjo,
jetzt verstehe ich gar nichts mehr! Ich hatte einen Code geschrieben, bei dem die erste Zeile übertragen wird. Danach schreibst du, dass der Autofilter automatisch durchlaufen werden soll. Der Code, den ich anschließend gepostet habe, überträgt alle per Autofilter ausgewählten Datensätze eines Kunden. Und jetzt mit einem Mal doch wieder nur die erste Zeile? Was soll denn dann nun "automatisch durchlaufen" werden mit dem Autofilter?
Bis später,
Karin
jetzt verstehe ich gar nichts mehr! Ich hatte einen Code geschrieben, bei dem die erste Zeile übertragen wird. Danach schreibst du, dass der Autofilter automatisch durchlaufen werden soll. Der Code, den ich anschließend gepostet habe, überträgt alle per Autofilter ausgewählten Datensätze eines Kunden. Und jetzt mit einem Mal doch wieder nur die erste Zeile? Was soll denn dann nun "automatisch durchlaufen" werden mit dem Autofilter?
Bis später,
Karin
Antwort 11 von fedjo
Hallo Karin,
ich möchte ich noch mal für deine Hilfe und Ausdauer bedanken!
Meine Frage mit dem Autofilter der automatisch durchlaufen soll, habe ich vielleicht falsch gestellt.
Übertragen sollte nur der Name des Lieferanten (Autofilter)
und der Mittelwert aus den Zellen (E2:J2) da hier eine Funktion hinterlegt ist.
Autofilter automatisch durchlaufen:
Wenn mit dem Autofilter der erste Datensatz eines Lieferanten gefiltert, kopiert (Name, E2:J2) in die Tabelle (Auswerten) eingefügt ist, sollte er automatisch den nächsten Datensatz eines Lieferanten aufrufen, kopieren usw
bis zum Ende aller Filtersätze aus dem Autofilter übertragen wurden.
Gruß
fedjo
ich möchte ich noch mal für deine Hilfe und Ausdauer bedanken!
Meine Frage mit dem Autofilter der automatisch durchlaufen soll, habe ich vielleicht falsch gestellt.
Übertragen sollte nur der Name des Lieferanten (Autofilter)
und der Mittelwert aus den Zellen (E2:J2) da hier eine Funktion hinterlegt ist.
Autofilter automatisch durchlaufen:
Wenn mit dem Autofilter der erste Datensatz eines Lieferanten gefiltert, kopiert (Name, E2:J2) in die Tabelle (Auswerten) eingefügt ist, sollte er automatisch den nächsten Datensatz eines Lieferanten aufrufen, kopieren usw
bis zum Ende aller Filtersätze aus dem Autofilter übertragen wurden.
Gruß
fedjo
Antwort 12 von Beverly
Hi Fedjo,
das ist für mich ein Widerspruch: weshalb soll der Name des Lieferanten mehrfach zusammen mit dem Mittelwert kopiert werden? Der Mittelwert bleibt doch immer gleich.
Oder meinst du, dass der Autofilter automatisch gesetzt und alle Lieferanten einschließlich ihres Mittelwertes übertragen werden sollen, sodass am Ende eine zusammengefasste Tabelle aller Lieferanten einschließlich Mittelwert entsteht?
Bis später,
Karin
das ist für mich ein Widerspruch: weshalb soll der Name des Lieferanten mehrfach zusammen mit dem Mittelwert kopiert werden? Der Mittelwert bleibt doch immer gleich.
Sub Mittelwert()
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim loZeile As Long
Application.ScreenUpdating = False
loLetzte2 = IIf(IsEmpty(Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5)), Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5).End(xlUp).Row, Worksheets("Auswerten").Rows.Count)
With Worksheets("MW")
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
.Range("B" & loLetzte1).Copy Worksheets("Auswerten").Cells(loLetzte2 + 1, 1)
.Range("E2:J2").Copy
Worksheets("Auswerten").Range(Cells(loLetzte2 + 1, 2), Cells(loLetzte2 + 1, 7)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Worksheets("Auswerten").Activate
With ActiveSheet
loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 5)), .Cells(.Rows.Count, 5).End(xlUp).Row, .Rows.Count)
.Range("A2:G" & loLetzte2).Sort Key1:=Range("A2"), Header:=xlYes
End With
Worksheets("MW").Activate
Application.ScreenUpdating = False
End Sub
Oder meinst du, dass der Autofilter automatisch gesetzt und alle Lieferanten einschließlich ihres Mittelwertes übertragen werden sollen, sodass am Ende eine zusammengefasste Tabelle aller Lieferanten einschließlich Mittelwert entsteht?
Bis später,
Karin
Antwort 13 von fedjo
Hallo Karin,
hier wird ein Fehler angzeigt:
Genau so habe ich das gemeint:
Gruß
fedjo
hier wird ein Fehler angzeigt:
Zitat:
xlPasteValuesAndNumberFormats
xlPasteValuesAndNumberFormats
Genau so habe ich das gemeint:
Zitat:
Oder meinst du, dass der Autofilter automatisch gesetzt und alle Lieferanten einschließlich ihres Mittelwertes übertragen werden sollen, sodass am Ende eine zusammengefasste Tabelle aller Lieferanten einschließlich Mittelwert entsteht?
Oder meinst du, dass der Autofilter automatisch gesetzt und alle Lieferanten einschließlich ihres Mittelwertes übertragen werden sollen, sodass am Ende eine zusammengefasste Tabelle aller Lieferanten einschließlich Mittelwert entsteht?
Gruß
fedjo
Antwort 14 von Beverly
Hi Fedjo,
hier der geänderte Code
Ich habe schon eine ganze Menge Zeit in die Lösung deines Problems investiert und dir mehrere Codes gepostet. Wäre von Anfang an die Aufgabenstellung klar beschrieben gewesen, hätte ich einen anderen Lösungsweg als mit Autofilter eingeschlagen. Jetzt noch einmal komplett von vorne zu beginnen ist mir zu aufwendig. Vielleicht kann dir ja jemand anderes helfen.
Bis später,
Karin
hier der geänderte Code
Sub Mittelwert()
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim loZeile As Long
Application.ScreenUpdating = False
loLetzte2 = IIf(IsEmpty(Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5)), Worksheets("Auswerten").Cells(Worksheets("Auswerten").Rows.Count, 5).End(xlUp).Row, Worksheets("Auswerten").Rows.Count)
With Worksheets("MW")
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
.Range("B" & loLetzte1).Copy Worksheets("Auswerten").Cells(loLetzte2 + 1, 1)
.Range("E2:J2").Copy
End With
Worksheets("Auswerten").Activate
With ActiveSheet
loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 5)), .Cells(.Rows.Count, 5).End(xlUp).Row, .Rows.Count)
.Range(Cells(loLetzte2 + 1, 2), Cells(loLetzte2 + 1, 7)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("A2:G" & loLetzte2).Sort Key1:=Range("A2"), Header:=xlYes
End With
Worksheets("MW").Activate
Application.ScreenUpdating = False
End Sub
Ich habe schon eine ganze Menge Zeit in die Lösung deines Problems investiert und dir mehrere Codes gepostet. Wäre von Anfang an die Aufgabenstellung klar beschrieben gewesen, hätte ich einen anderen Lösungsweg als mit Autofilter eingeschlagen. Jetzt noch einmal komplett von vorne zu beginnen ist mir zu aufwendig. Vielleicht kann dir ja jemand anderes helfen.
Bis später,
Karin
Antwort 15 von fedjo
Hallo Karin,
ich hatte versucht mein Problem so gut wie möglich zu beschreiben. Dein Code funktioniert super, habe in so in meine Tabelle eingefügt.
Ich danke dir noch mal für deine Hilfe und Ausdauer.
Gruß
fedjo
ich hatte versucht mein Problem so gut wie möglich zu beschreiben. Dein Code funktioniert super, habe in so in meine Tabelle eingefügt.
Ich danke dir noch mal für deine Hilfe und Ausdauer.
Gruß
fedjo