Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1352to1356
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

Aufgezeichnetes Makro braucht den letzten Schliff

Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 00:10:13
BiBaBEN
Hallo,
ich habe mir ein Makro aufgezeichnet mit dem ich eine Tabelle filter und den gefilterten Inhalt in eine neue Tabelle kopiere.
Aber wenn der ausgewählte Bereich keine Daten enthält, dann soll auch nicht kopiert und eingefügt werden.
So sieht das Makro aus:
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12, Criteria1:="1"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3, Criteria1:="1"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2, Criteria1:="5"
Range("A19").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A19:K19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Richtung1").Select
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select

Sheets("Basis").Select
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12
Range("E13").Select

Ich nehme mal an, das irgendwie um den FETT markierten bereich herum eine IF...THEN Geschichte hin muss, aber wie das geht ist mir grad zu hoch ;)
Danke schonmal fürs Ideen sammeln,
Gruß Ben

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

Betreff
Datum
Anwender
Anzeige
AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 00:36:47
Oberschlumpf
Hi Ben
direkt unterhalb der 3 Filterzeile:
If Range("A19").Value = "" Then Exit Sub
prüft, ob in A19 ein Wert steht, wenn nicht, wird der weitere Code NICHT ausgeführt.
Hilfts?
Ciao
Thorsten

AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 01:00:46
BiBaBen
Hi Thorsten,
leider hilft es so nicht.....
Was ich wohl noch erwähnen muss, ist das ich diesen Block den ich hier rein kopiert habe für mein Makro mehere male angelegt habe. Also für jede Filtervariante die ich haben will einen.
Hier mal ein Bsp. für 3 Filtervarianten (ich habe noch ein paar mehr):
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12, Criteria1:="1"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3, Criteria1:="1"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2, Criteria1:="8"
Range("A19").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A19:K19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Richtung1").Select
Range("F100").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Sheets("Basis").Select
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12
Range("E13").Select
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12, Criteria1:="1"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3, Criteria1:="2"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2, Criteria1:="9"
Range("A19").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A19:K19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Richtung1").Select
Range("F134").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Sheets("Basis").Select
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12
Range("E13").Select
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12, Criteria1:="1"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3, Criteria1:="2"
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2, Criteria1:="10"
Range("A19").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A19:K19").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Richtung1").Select
Range("F166").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Sheets("Basis").Select
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=2
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=3
ActiveSheet.Range("$A$18:$L$320").AutoFilter Field:=12
Range("E13").Select

Funktioniert in der Form so wie ich das gern hätte, nur musste ich nun feststellen, dass wenn eine Filtervariante "leer" ist, VBA dann mit dem Kopieren nicht mehr klar kommt und eine Fehlermeldung ausspuckt.
Laufzeitfehler 1004
Und da dachte ich nun, das ich das Problem umgehen könnte, indem ich sage: "Kopiere und Füge nur eine Auswahl ein, die auch Daten enthält!"
Bestimmt keine elegante Lösung und jemand der "Ahnung" von VBA hat dem stellen sich dabei sicherlich die Haare zu Berge..... aber leider nicht mit meinen Kenntnissen lösbar.
Gruß Ben

Anzeige
AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 01:05:37
Oberschlumpf
Hi Ben
Zeig am besten mal ne Bsp-Datei mit Bsp-Daten und dem Code. Der Code sollte schon funktionieren, wenn nach Filter auch Daten zum Kopieren vorhanden sind.
Ciao
Thorsten

AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 01:33:10
BiBaBen
Hi;
hier ein Beispiel, das Makro ist noch nicht ganz fertig, aber über den blauen Button im Blatt Basis kann man es starten.
Wie schon gesagt, wenn Daten da sind nach dem Filter geht es, nur eben nicht wenn keine Daten da sind.
Link:
http://www.file-upload.net/download-8771516/Beispieldatei_Zuteilung_Fahrten.xlsm.html

Anzeige
AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 01:41:26
BiBaBen
PS: die frage ist noch offen ;)

AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 03:27:28
Oberschlumpf
Hi Ben
So, hier meine Idee:
https://www.herber.de/bbs/user/89935.zip
(ZIP-Datei ERST entpacken, dann die Datei xy.xls in Excel öffnen!)
Vergleich mal deinen Code im Sub Fahrten_Zuteilen, und schau dir dann mal meinen Code in den Subs sbZuteilung + sbStart an.
Du schreibst über 400 Codezeilen, ich brauch nur n bisschen mehr als 80 Zeilen :-)
Mein Code macht trotzdem das Gleiche wie dein Code :-)
Der Grund:
Du, bzw der Makrorecorder wiederholt sehr oft sehr viele Codezeilen.
Ich habe ins Sub sbZuteilung nur die Zeilen geschrieben, die sein müssen.
Die Wiederholung all dieser Zeilen erfolgt mit Hilfe der Sub sbStart.
Das heißt....
die 1. Zeile in sbStart
sbZuteilung 1, 1, 5, "F4"
ruft das Sub sbZuteilung auf und übergibt gleich die erforderlichen Parameter, die sich ja auch für jede Wiederholung des Codes ändern.
Filterkriterien für die 1. Codezeile in sbStart
1 für Richtung
1 für h
5 für Stunde
Zelle F4 ist der Beginn des Bereichs in Tabelle "Richtung1", in dem die Wertezeilen eingefügt werden
Filterkriterien für die 2. Codezeile in sbStart
sbZuteilung 1, 1, 6, "F36"
1 für Richtung
1 für h
6 für Stunde
Zelle F36 ist der Beginn des Bereichs in Tabelle "Richtung1", in dem die Wertezeilen eingefügt werden
usw...
Im Sub sbZuteilung wird nun erst geprüft, ob nach dem Filtern Datenzeilen angezeigt werden.
Werden keine angezeigt, wird auch kein weiterer Code ausgeführt - doch, der Filter wird wieder zurück gesetzt.
Im Code ist es noch mal erklärt.
Hilfts denn?
Ciao
Thorsten

Anzeige
AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 08:28:53
BiBaBen
WOW,
auf den ersten Blick hat alles funktioniert. Ich bin begeistert.....DANKE!!!!
Eine kleine Sache wäre da noch:
Das Makro sortiert ja alle gefilterten Daten in die Tabelle "Richtung1"
sbZuteilung 1, 1, 8, "F100"
aber das ganze muss auch funktionieren, wenn der Filter auf Tabelle "Richtung2" das dann dorthin kopiert wird.
sbZuteilung 2, 1, 8, "F100"
Der aufbau der beiden Richtungstabellen ist identisch.
Gibt es dazu noch eine Lösung?

AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 10:46:24
Oberschlumpf
Moin Ben
hier die Datei mit dem erweiterten Code:
https://www.herber.de/bbs/user/89938.zip
Ja, für Richtung2 geht das Ganze auch.
Ich hab in der Sub sbStart die ersten 3 Zeilen kopiert, am Ende des Codes eingefügt und aus der ersten 1 ne 2 gemacht.
Dann den Code über den Button gestartet, und auch in Richtung2 befinden sich die entsprechenden Wertezeilen an den gleichen Stellen wie in Richtung1.
Ach so, genau so, wie ich in sbStart 3 weitere Zeilen hinzugefügt habe, kannst auch du weitere Codezeilen hinzufügen.
Denn sowohl in Richtung1, als auch in Richtung2 fehlen ja noch Wertezeilen.
Du musst halt nur die richtigen Parameter übergeben.
Guck dir auch mal den Code fürs Löschen der Inhalte an.
Ich hab dort den Code auch mal bereinigt :-)
Passt denn nun alles?
Ciao
Thorsten

Anzeige
AW: Aufgezeichnetes Makro braucht den letzten Schliff
01.04.2014 11:38:15
BiBaBen
TAUSEND MAL TAUSEND UND NOCHMAL TAUSEND DANK ! ! !
So wie du es zurechtgebastelt hast Funktioniert das Makro PERFEKT.
Für die paar Anpassungen die ich noch machen musste reichen meine VAB-Kenntnise zum Glück grad so aus ;-)
Gruß Ben

freut mich, wenns gefällt :-), aber...
01.04.2014 11:51:32
Oberschlumpf
Hi Ben
Du hast VAB-Kenntnisse?
Cool, da weißt du schon mal viel mehr als ich.
Denn ich weiß nich mal, was VAB ist :-)))
Ciao
Thorsten

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige