[Excel] Vergleich 2er Spalten in 2 verschiedenen Tabellen mit Ausgabe in 3. Tabelle

[Stef_an]

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'

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

 

[tombe]

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.

 

[Stef_an]

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....

 

[tombe]

Ok, versuchen wir es nochmal anders:

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

 

[Stef_an]

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

 

[tombe]

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

'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.

 

[Stef_an]

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.

 

[tombe]

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

Sub IrgendeinName()
Application.ScreenUpdating = False

'hier der restliche Code

Application.ScreenUpdating = True
End Sub

 

[tombe]

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

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.

 

[Stef_an]

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!