mein problem ist das die zeile die ausgelesen und kopiert werden muss 20 spalten hat und alle spalten müssen ausgelesen werden dehalb habe ich Tabelle3.Cells(zeile3, 2) = Tabelle2.Cells(zeile2, 3)
in Tabelle3.Cells(zeile3) = Tabelle2.Cells(zeile2) abgeändert, aber es wird nur die zeile des allerersten treffers ausgelesen, sonst listet der code nur noch die treffer selber auf aber nicht mehr die 20 spalten dahinter

Zitat von Stef_an

achte bitte auch auf die zellen ab spalte AA, warum der code das macht versteh ich beim besten willen nicht.

Geht mir genau so, denn es gibt nichts im Code bei dem diese Spalten angesprochen werden.

Aber egal:

Code vb:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Dim zeile1, zeile2, zeile3   zeile1 = 1 zeile2 = 1 zeile3 = 1   'komplette Tabelle3 löschen Tabelle3.Range("A1:Z65536").Clear   'Tabelle1 durchlaufen und mit Tabelle2 vergleichen Do While Tabelle1.Cells(zeile1, 1) <> ""     Do While Tabelle2.Cells(zeile2, 1) <> ""         If Tabelle1.Cells(zeile1, 1) = Tabelle2.Cells(zeile2, 1) Then 'die nächsten 2 Zeilen sind neu/geändert            Tabelle2.Range(zeile2 & ":" & zeile2).Copy             Tabelle3.Range(zeile3 & ":" & zeile3).Insert            zeile3 = zeile3 + 1         End If         zeile2 = zeile2 + 1     Loop     zeile1 = zeile1 + 1     zeile2 = 1 Loop

Gruß Thomas

Hi,

es funktioniert!

Tausend Dank!

Eine Sache habe ich noch.
Da die Daten in Tabelle 1 und 2 in der Realität in verschiedenen .xls Dateien auf verschiedenen Servern liegen, wäre es nett von dir wenn du mir sagen könntest in welcher Form ich den Pfad zur Datei in den Code einfügen muss

Danke!

Also wenn es sich immer um die gleichen Dateien handelt, kannst du die Namen einfach vor die entsprechenden Tabellennamen schreiben:

"C:\Dokumente und Einstellungen\User\Eigene Dateien\Dateiname.xls!" & Tabelle2.Cells(zeile2, 1)

Hi,

ich habe Probleme den Code in der Serverumgebung zum laufen zu kriegen
Er meldet mir immer bei den Do While Schleifen einen Laufzeitfehler '1004'

Code vb:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

Private Sub CommandButton1_Click() Dim zeile1, zeile2, zeile3   zeile1 = 3 zeile2 = 10 zeile3 = 2   'komplette Daten löschen Tabelle2.Range("A2:AB65536").Clear 'Spalten D,O,S in Datumausgabe formatieren Tabelle2.Range("D:D").NumberFormat = "DD.MMMM.YYYY" Tabelle2.Range("O:O").NumberFormat = "DD.MMMM.YYYY" Tabelle2.Range("S:S").NumberFormat = "DD.MMMM.YYYY" Tabelle2.Range("X:X").NumberFormat = "DD.MMMM.YYYY" 'Arbeitsdatei PTI xx durchlaufen und mit Trommel_aktuell vergleichen Do While "\\164.23.123.150\pti14_megaplan\Birgit\Arbeitsdatei PTI xx Terminüberwachung aktuell.xls!" & Tabelle2.Cells(zeile1, 1) <> ""     Do While "\\164.23.123.150\ptixx_megaplan\Birgit\Trommel_aktuell.xls!" & Tabelle1.Cells(zeile2, 2) <> ""         If "\\164.23.123.150\ptixx_megaplan\Birgit\Arbeitsdatei PTI xx Terminüberwachung aktuell.xls!" & Tabelle2.Cells(zeile1, 1) = "\\164.23.123.150\ptixx_megaplan\Birgit\Trommel_aktuell.xls!" & Tabelle1.Cells(zeile2, 2) Then         'die nächsten 2 Zeilen sind neu/geändert                    "\\164.23.123.150\ptixx_megaplan\Birgit\Trommel_aktuell.xls!".Tabelle1.Range(zeile2 & ":" & zeile2).Copy                     Tabelle2.Range(zeile3 & ":" & zeile3).Insert            zeile3 = zeile3 + 1         End If         zeile2 = zeile2 + 1     Loop     zeile1 = zeile1 + 1     zeile2 = 10 Loop End Sub

Hmmmmmm, was die Fehlermeldung/-nummer bedeutet ist eine gute Frage.

Lösungsvorschlag 1:
Wenn du an dem Rechner auf dem die Excel Datei liegt einen Laufwerksbuchstaben für das Verzeichnis auf dem Server angibst, könnte das vielleicht schon helfen. Dann mußt du nicht den kompletten Pfad angeben

Lösungsvorschlag 2:
Du speicherst die Excel Datei nicht lokal auf einem Rechner sondern legst sie im gleichen Verzeichnis ab wie die anderen Excel Dateien. Dann sparst du dir ebenfalls die Pfadangaben.

Die Datei liegt im selben Verzeichnis auf dem Server wie die Dateien aus denen ausgelesen wird.
auch wenn ich den pfad weglasse und nur den dateinamen und die tabelle anspreche kommt die fehlermeldung.

ich habe auch versucht mit Worksheet_Activate zu arbeiten, hat aber auch nichts gebracht.

ganz schön frustrierend....

Ok, versuchen wir es nochmal anders:

Code vb:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36

Dim zeile1, zeile2, zeile3   zeile1 = 1 zeile2 = 1 zeile3 = 1   Dim wb1 As Workbook Dim ws1 As Worksheet Set wb1 = Workbooks.Open("Datei1.xls") Set ws1 = wb1.Worksheets("Tabelle1")   Dim wb2 As Workbook Dim ws2 As Worksheet Set wb2 = Workbooks.Open("Datei2.xls") Set ws2 = wb2.Worksheets("Tabelle2")   'komplette Tabelle3 löschen Tabelle3.Range("A1:Z65536").Clear   'Tabelle1 durchlaufen und mit Tabelle2 vergleichen Do While ws1.Cells(zeile1, 1) <> ""     Do While ws2.Cells(zeile2, 1) <> ""         If ws1.Cells(zeile1, 1) = ws2.Cells(zeile2, 1) Then 'die nächsten 2 Zeilen sind neu/geändert            ws2.Range(zeile2 & ":" & zeile2).Copy             Tabelle3.Range(zeile3 & ":" & zeile3).Insert            zeile3 = zeile3 + 1         End If         zeile2 = zeile2 + 1     Loop     zeile1 = zeile1 + 1     zeile2 = 1 Loop   wb1.Close wb2.Close

Es gibt jetzt 3 Dateien, Datei0.xls, Datei1.xls und Datei2.xls.

Datei0.xls: Sie enthält nur den Button um das Makro auszuführen und es werden dann in Tabelle3 die Daten eingetragen die zurückgeliefert werden.

Datei1.xls: Sie enthält die Liste der "Artikelnummern" die gesucht werden in Tabelle1.

Datei2.xls: Sie enthält die Daten nach denen gesucht wird und die dann übertragen werden.

Du musst jetzt halt noch die Dateinamen und eventuell die Namen der Tabellen anpassen. Ansonsten sollte es so funktionieren.

Gruß Thomas

So endlich klappt es. Vielen Vielen Dank!
Die Abfrage dauert übrigens eine knappe Stunde, aber damit kann ich leben.

Die Dauer ist blöd aber wenigstens klappt es, trotzdem hier noch eine kleine Änderung.
Keine Ahnung wie viele Daten du bei dir in den Dateien hast, ich habe mal bei

Datei 1: 1.000 Einträge

und bei

Datei 2: 10.530 Einträge

eingetragen.

Anschließend habe ich folgende Zeilen ins Makro eingetragen

Code vb:

1 2 3 4 5

'ganz oben Application.ScreenUpdating = False   'ganz unten Application.ScreenUpdating = True

Makro laufen lassen, begonnen um 12:06:10 und fertig um 12:11:18

Dann habe ich die Zeilen mal auskommentiert und das Makro nochmal laufen lassen, begonnen um 12:12:48 und fertig um 12:20:47 Uhr.

Das könnte sich bei dir dann erst recht lohnen ! ! ! Ich probiere trotzdem noch mal rum ob das nicht noch schneller geht.

Wo genau hast du die zeilen eingefügt? in der do while schleife oder ausserhalb, also nach dem deklarieren der Variablen und vor dem End Sub.

Ja, ganz zu Beginn bzw. ganz am Ende des Makros:

Code vb:

1 2 3 4 5 6 7

Sub IrgendeinName() Application.ScreenUpdating = False   'hier der restliche Code   Application.ScreenUpdating = True End Sub

So ich habe mit den obigen Musterdaten (1.000 und 10530) nun eine Laufzeit von etwas mehr als 2 Minuten:

Code vb:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62

Application.ScreenUpdating = False   Dim zeile1   zeile1 = 1   Dim wb1 As Workbook Dim ws1 As Worksheet Set wb1 = Workbooks.Open("Datei1.xls") Set ws1 = wb1.Worksheets("Tabelle1")   Dim wb2 As Workbook Dim ws2 As Worksheet Set wb2 = Workbooks.Open("Datei2.xls") Set ws2 = wb2.Worksheets("Tabelle2")   'die kompletten Tabellen 1, 2 und 3 löschen Tabelle1.Range("A1:Z65536").Clear Tabelle2.Range("A1:Z65536").Clear Tabelle3.Range("A1:Z65536").Clear   'Daten der Tabelle1 in Quelldatei kopieren und hier einfügen ws1.UsedRange.Copy Tabelle1.Activate Tabelle1.Range("A1").Select Tabelle1.Paste wb1.Close   'Daten der Tabelle2 in Quelldatei kopieren und hier einfügen ws2.UsedRange.Copy Tabelle2.Activate Tabelle2.Range("A1").Select Tabelle2.Paste wb2.Close   'Tabelle1 durchlaufen und mit Tabelle2 vergleichen Tabelle2.Activate Do While Tabelle1.Cells(zeile1, 1) <> ""     'Filter in Tabelle2 setzen und wenn vorhanden Daten in Tabelle3 kopieren    Selection.AutoFilter     Selection.AutoFilter Field:=1, Criteria1:=Tabelle1.Cells(zeile1, 1)         For a = Tabelle2.Range("a65536").End(xlUp).Row To 1 Step -1         If Rows(a).Hidden = False Then gesamt = gesamt + 1     Next       If gesamt > 1 Then         Tabelle2.Rows(1).EntireRow.Hidden = True         Tabelle2.UsedRange.Copy         Tabelle2.Rows(1).EntireRow.Hidden = False         Tabelle3.Activate         zelle = Tabelle3.Cells(Rows.Count, 1).End(xlUp).Row         Tabelle3.Range("A" & zelle + 1).Select         ActiveSheet.Paste         Tabelle2.Activate     End If     gesamt = 0     Selection.AutoFilter     zeile1 = zeile1 + 1 Loop   Application.ScreenUpdating = True

Wichtig bei dieser Version ist, das die Originaldaten komplett kopiert und bei mir in Datei0 eingefügt werden.
Dann wird anhand der Werte in Tabelle1 ein Filter in Tabelle2 gesetzt und sofern Treffer vorhanden sind, werden diese auf einmal in Tabelle3 kopiert.

hi,
der code den du als letztes gepostet hast funktioniert bei mir leider nicht. es wird zwar gerechnet, jedoch wird nichts kopiert. ich habe jedoch deinen vorher geposteten code etwas modifiziert und komme nun auf 26-30 min.
das ist meines erachtens völlig ok. für das vergleichen von 2500 datensätzen mit 50000 datensätzen

vielen dank!