ComputerBase Menü
Aktuelles

VBA - Aus zwei verschiedenen Excel-Datein nur relevante Zeilen einlesen

R

rhodium

Cadet 3rd Year
Registriert
Feb. 2013
Beiträge
63
Hallo,

die Suchfunktion und Google bringt mich nicht viel weiter - verschiedene Ergebnisse, nichts direkt passendes - ich werde nicht daraus schlau.

Ich habe ein Makro in einer separaten Excel-Datei. Zurzeit liest das Makro alle Daten aus zwei Excel-Dateien in die separate ein.

Ich möchte aber, dass nur die Zeilen eingelesen werden, die in Spalte C eine bestimmte Zahl und in Spalte F ein A oder B stehen haben.

Kann mir da kurz jemand helfen?
 
Zuletzt bearbeitet:
Klar, ist doch ganz einfach...die trägst einfach in der richtigen Zeile im Makro die Bedingung ein.

Bitte, habe dir gerne geholfen
 
Richtig, @CHaos.Gentle hat die richtige Antwort schon gegeben.

Wenn man hier helfen soll, müssen schon ein paar mehr Infos kommen.

z.B. Dein VBA-Code und welche Zahlen er berücksichtigen soll.
 
Lass das Makro doch nach dem Öffnen einen Autofilter mit den gewünschten Kriterien durchführen und kopieren nur die sichtbaren Zeilen.
 
alxtraxxx schrieb:
Lass das Makro doch nach dem Öffnen einen Autofilter mit den gewünschten Kriterien durchführen und kopieren nur die sichtbaren Zeilen.
Zum Vergrößern anklicken....

Klingt einfach. Kannst du mir den Befehl nennen, mit dem man nur sichtbare Zeilen kopiert?

Dabei könnte aber ein Problem entstehen. Ich hatte nämlich zuerst versucht, die Zieldatei zu filtern. Es sind aber zu viele Möglichkeiten in Spalte C vorhanden. VBA hat dann rumgemeckert, dass es zu viele Einträge seien (alle, die angezeigt werden sollen). Das könnte da natürlich auch entstehen.
Ich hatte auch bereits einen Code, der in der Zieldatei alle Zeilen gelöscht hat, die 1000 und nicht A oder B enthielten. Das hat aber ewig gedauert.


Ok, hier der Code.
Es sollen alle Zeilen der Dateien A1 und B1 in yyy kopiert werden, welche in Spalte C keine 1000 und in Spalte F ein A oder ein B haben.


Option Explicit

Public sFileA1 As String
Public sFileB1 As String


Sub DateiauswahlA1_Klicken()
sFileA1 = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
MsgBox (sFileA1)
End Sub

Sub DateiauswahlB1_Klicken()
sFileB1 = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
MsgBox (sFileB1)
End Sub

Sub DatenEinlesen_Klicken()

Dim NeuerTabellenName As String

' Schaltfläche1_Klicken Makro
' ------------------- A1 ------------------------------
' Zuvor durch den Benutzer ausgewählte Datei öffnen.
Workbooks.Open Filename:=sFileA1
' Selektieren und Kopieren aller Spalten mit Daten
Columns("A:AJ").Select
Selection.Copy


'EINFÜGEN DER QUELLDATEN IN NEUE EXCELDATEI - *A1*
' Aktivieren der Excel-Datei yyy
Windows("yyy.xlsm").Activate
' Erstellen eines neuen Blattes mit variablen Namen durch Benutzer-Eingabe
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
NeuerTabellenName = InputBox("Neuer Name des Blattes")
ActiveSheet.Name = NeuerTabellenName
' Einfügen der Daten
Range("A1").Select
ActiveSheet.Paste

' SCHLIESSEN DER QUELLDATEI
' Automatisches Beantworten der Frage, ob die große Menge in der Zwischenablage behalten werden soll
Application.CutCopyMode = False
' Datei mit Exportdaten wieder aktivieren
Windows("A1.xlsx").Activate
' Frage nach Speicherung der Änderungen mit "nein" beantworten
ActiveWindow.Close savechanges:=False


' ------------------- B1 -------------------------------
' Zuvor durch den Benutzer ausgewählte Datei öffnen.
Workbooks.Open Filename:=sFileB1
' Selektieren und Kopieren aller Spalten mit Daten
Rows("2:5000").Select
Selection.Copy

'EINFÜGEN DER QUELLDATEN IN NEUE EXCELDATEI - *B1*
' Aktivieren der Excel-Datei yyy
Windows("yyy.xlsm").Activate
' Erste leere zeile der Tabelle suchen
Worksheets(NeuerTabellenName).Range("A65536").End(xlUp).Offset(1, 0).Select
' Einfügen der Daten
ActiveSheet.Paste

' SCHLIESSEN DER QUELLDATEI
' Unterdrücken nach der Frage, ob die große Menge in der Zwischenablage behalten werden soll
Application.CutCopyMode = False
' Datei mit Exportdaten wieder aktivieren
Windows("B1.xlsx").Activate
' Frage nach Speicherung der Änderungen mit "nein" beantworten
ActiveWindow.Close savechanges:=False
' ----------------------------------------------------------

' Aktivieren der Excel-Datei yyy
Windows("yyy.xlsm").Activate
End Sub
 
Zuletzt bearbeitet:
Uhh...nicht schön aber funktioniert ja ;)

So kann man dir tatsächlich helfen. Für das was du willst müsste man den Code komplett umschreiben...aber es geht auch anders.
Du lässt alles so und löschst am Ende einfach die nicht benötigten Zeilen.

Code: 
Sub clearrows()
Dim i As Integer
Dim iEnd As Integer

iEnd = Worksheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row

For i = 1 To iEnd
If (Cells(i, 6) = "A" Or Cells(i, 6) = "B") And Not Cells(i, 3) = 1000 Then
  Rows(i).Delete
  i = i - 1
End If
Next i

End Sub

Bei dir fügst du das in das Script ein. Außerhalb deiner aktuellen Sub.
Dein Sub erweiterst du direkt vor dem End Sub um
Code: 
[...]
clearrows
Application.ScreenUpdating = True
End Sub
und
Code: 
Sub DatenEinlesen_Klicken()

Dim NeuerTabellenName As String

'Schaltfläche1_Klicken Makro
Application.ScreenUpdating = False
[...]
 
rhodium schrieb:
Klingt einfach. Kannst du mir den Befehl nennen, mit dem man nur sichtbare Zeilen kopiert?

Dabei könnte aber ein Problem entstehen. Ich hatte nämlich zuerst versucht, die Zieldatei zu filtern. Es sind aber zu viele Möglichkeiten in Spalte C vorhanden. VBA hat dann rumgemeckert, dass es zu viele Einträge seien (alle, die angezeigt werden sollen). Das könnte da natürlich auch entstehen.
Ich hatte auch bereits einen Code, der in der Zieldatei alle Zeilen gelöscht hat, die 1000 und nicht A oder B enthielten. Das hat aber ewig gedauert.
Zum Vergrößern anklicken....


Danke für deine Hilfe. Das Problem ist, dass ich etwa 5000 Zeilen habe, von denen nur wenige (ca 100-200) keine 1000 und A oder B enthalten.
Daher dauert das rauslöschen knapp 5 Minuten.
Ergänzung ()

Meine Kenntnisse im VBA-Programmieren sind sehr gering. Das meiste mache ich über das Aufzeichnen von Makros und passe das dann an. Anderes Google ich mir zusammen :-D

Ich dachte daran, dass ich sowas baue:

Öffne Datei A1
Prüfe Ob in Zeile i in Spalte 3 keine 1000 vorhanden ist und in Spalte...
Dann kopiere Zeile
Aktiviere Datei yyy
Suche erste leere Zeile
Einfügen der kopierten Zeile
i=i+1
ansonsten gehe zur nächsten Spalte
wiederholen der Struktur.


Ich weiß nur leider überhaupt nicht, wie ich das in Programmiersprache bringen kann :-(
 
Application.Screenupdating = False ist der Schlüssel...

Deshalb habe ich das da hingeschrieben. Danach wird der gesamte Vorgang ein paar Sekunden dauern.

Beim Zeilenweisen kopieren hast du anstatt X Löschvorgänge Zeilenanzahl - X Kopiervorgänge. Da der Kopiervorgang länger dauert als der Löschvorgang, dauert damit auch der gesamte Vorgang länger.
Man müsste also wenn in der Quelle eine komplexe Selection bauen und die gesamthaft kopieren.

Quick and dirty geht aber auch ;)
 
Zuletzt bearbeitet:
mhh... das hat dann wohl nicht funktioniert. Ich teste nochmal. Moment.
Ergänzung ()

Ok. Jetzt sehe ich nicht mehr, wie Excel arbeitet. Nur noch einen sich drehenden Kreis als Mauszeiger, also ne Sanduhr.

Allerdings dauert es trotzdem lange... jetzt schon 3 Minuten und er ist noch nicht fertig.
 
Ich würde das eher mit Excel-Mitteln machen, For-Schleifen sind grottig lahm im VBA/Excel

Columns("A:C").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$11").AutoFilter Field:=3, Criteria1:="=1000", _
Operator:=xlAnd
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Tabelle2").Select
ActiveSheet.Paste
Zum Vergrößern anklicken....
Bei mir kopiert/fügt er dann auch nur die sichtbaren ein, Bereiche müssen natürlich angepasst werden etc.
 
Ja, funktioniert prinzipiell. Allerdings kann er die Zahl nicht filtern, da es wohl keine Zahl sondern Text ist.
In der Zelle der Quelle steht
="1000".

Ich könnte auch eine andere Spalte nehmen. Das ist vielleicht sogar sinnvoller. Jeder Zahl ist nämlich ein Wort zugeordnet. Die sind aber nicht immer vollständig identisch.

Das wäre dann also:

Range("A1:AJ1").AutoFilter Field:=5, Criteria1:="<>Wort", Operator:=xlAnd

Aber: Ich brauche anstelle des <> etwas wie "enthält nicht" ...
Also er soll "Wort ABC" auch rausschmeißen, weil da ja "Wort" enthalten ist. Was muss ich da schreiben? Finde im Internet nichts.
Ergänzung ()

Ich glaube ich habs...

einfach "Wort*" ... also mit *.

Danke.
 
Zuletzt bearbeitet:
So vielleicht?
ActiveSheet.Range("$A$1:$M$7").AutoFilter Field:=5, Criteria1:="<>*Wort*", _
Operator:=xlAnd

Nix was der Makrorekorder einem nicht verrät, Dein Operator für Spalte 13 ist auch falsch wenn es ein Oder sein soll musst Du auch xlOr benutzen
 
Ja, das mit dem xlOr ist mir bereits aufgefallen ;-) Danke.

Also ich habe jetzt das, was ich wollte. Auch wenn mein Makro von Chaos.Gentle als "nicht schön" bezeichnet wurde, funktioniert es und das sogar ziemlich schnell (in Anbetracht der etwa 5000 Zeilen in den Dateien).

Ich bin daher erst einmal zufrieden.

Allerdings kopiert er leider aus der zweiten Datei nicht alle Spalten. Da muss ich jetzt noch auf Fehlersuche gehen.


Fertig bin ich aber noch lange nicht. Ziel ist es, wie ich bereits in einem anderen Thema sagte (dort habe ich nachgefragt, ob das überhaupt nicht Excel funktioniert) mehrere E-Mails über Outlook zu versenden (Nach Abfragen der Daten aus der Liste und mit diesen Daten). Aber das ist dann ein anderes Thema und passt nicht zu diesem.

DANKE.
Ergänzung ()

Ich muss das

Range(Selection, Selection.End(xlToRight)).Select

ersetzten. Da es zwischendurch 3 Spalten gibt, die nicht immer gefüllt sind, hört er dort leider auf zu selektieren. Danach in den Spalten kommen aber noch Daten.
 
Zuletzt bearbeitet:
Na Du hättest auch einfach mit der UsedRange die Anzahl der Spalten ermitteln können.
 
Ich kann mir nicjt vorstellen, dass das abarbeiten von 5.000 Zeilen rund 5 Min. dauert.

Entweder ist was am Code Mist oder die Datei ist aufgebläht, durch zum Beispiel leere Zellen, die aber als beschrieben erkannt werden.

Ich kann morgen mal eine Datei vorbereiten.
 
Haben Deine Quellsheets immer die selbe Struktur? Dann definiere einen fixen Bereich, so wie Du es am Anfang schon hattest. Und E-Mails via Outlook versenden geht auch, allerdings wird da der Makro Rekorder nicht ausreichen befürchte ich.
 
mac4life schrieb:
Ich kann mir nicjt vorstellen, dass das abarbeiten von 5.000 Zeilen rund 5 Min. dauert.

Entweder ist was am Code Mist oder die Datei ist aufgebläht, durch zum Beispiel leere Zellen, die aber als beschrieben erkannt werden.

Ich kann morgen mal eine Datei vorbereiten.
Zum Vergrößern anklicken....

Ja, der Code dürfte Mist sein :-D Aber er funktioniert. Aber ich habe das ganze ja anders gelöst.


Ich hab das Problem gelöst. Es funktioniert jetzt alles bis dahin. Danke.
 
Ich habe leider ein Problem.
Wenn es in einer der Dateien keine relevante Daten gibt, kann er natürlich nichts in die neue Datei einfügen und genau das gibt er mir dann als Fehler Meldung (Er markiert Zeile 47 gelb).
Was für Lösungen gibt es dafür? Ich vermute mal, dass das an vielen anderen Stellen auch passieren kann ?!

Danke.

Code: 
Option Explicit

 Public sFileA1 As String
 Public sFileB1 As String


 Sub DateiauswahlA1_Klicken()
 sFileA1 = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
 MsgBox (sFileA1)
 End Sub

 Sub DateiauswahlB1_Klicken()
 sFileB1 = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
 MsgBox (sFileB1)
 End Sub

 Sub DatenEinlesen_Klicken()

 Dim NeuerTabellenName As String

 ' Schaltfläche1_Klicken Makro
 ' ------------------- A1 ------------------------------
' Zuvor durch den Benutzer ausgewählte Datei öffnen.
    Workbooks.Open Filename:=sPfadA1
' Daten filtern
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1:AJ1").AutoFilter Field:=5, Criteria1:="<>xxx*"
    Range("A1:AJ1").AutoFilter Field:=6, Criteria1:="1000"
    Range("A1:AJ1").AutoFilter Field:=13, Criteria1:="A", Operator:=xlOr, Criteria2:=B"
    Range("1:1").Select
'    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

 'EINFÜGEN DER QUELLDATEN IN NEUE EXCELDATEI - *A1*
 ' Aktivieren der Excel-Datei yyy
 Windows("yyy.xlsm").Activate
 ' Erstellen eines neuen Blattes mit variablen Namen durch Benutzer-Eingabe
 Sheets.Add After:=Sheets(Sheets.Count)
 Sheets(Sheets.Count).Select
 NeuerTabellenName = InputBox("Neuer Name des Blattes")
 ActiveSheet.Name = NeuerTabellenName
 ' Einfügen der Daten
 Range("A1").Select
 ActiveSheet.Paste

 ' SCHLIESSEN DER QUELLDATEI
 ' Automatisches Beantworten der Frage, ob die große Menge in der Zwischenablage behalten werden soll
 Application.CutCopyMode = False
 ' Datei mit Exportdaten wieder aktivieren
 Windows("A1.xlsx").Activate
 ' Frage nach Speicherung der Änderungen mit "nein" beantworten
 ActiveWindow.Close savechanges:=False
End Sub
 
Zuletzt bearbeitet:
Du musst dich einloggen oder registrieren, um hier zu antworten.
Zurück
Oben

Willkommen auf ComputerBase!

Mit Werbung weiterlesen

Besuche ComputerBase wie gewohnt mit Werbung und Tracking. Die Zustimmung ist jederzeit widerrufbar.

Details im Privacy Center und in der Liste unserer Partner. Ein Widerruf ist möglich in der Datenschutzerklärung.

… oder ComputerBase Pro bestellen

Nutze ComputerBase ohne Werbebanner, Video-Ads und Werbetracking schon für 4 €/Monat oder 36 €/Jahr.

Mehr zu ComputerBase Pro

Bereits Pro-Nutzer? Hier anmelden.

Tracking: Wir und unsere 160 Partner verarbeiten personenbezogene Daten, indem wir mit auf Ihrem Gerät gespeicherten Informationen (z. B. eindeutige Kennungen in Cookies) ein Nutzungsprofil erstellen, um z. B. Anzeigen zu personalisieren. Verarbeitungszwecke: Genaue Standortdaten und Abfrage von Geräteeigenschaften zur Identifikation, Informationen auf einem Gerät speichern und/oder abrufen, Personalisierte Anzeigen und Inhalte, Anzeigen- und Inhaltsmessungen, Erkenntnisse über Zielgruppen und Produktentwicklungen.

Impressum Kontakt Datenschutz