ich habe folgendes Problem:
Ich habe zwei Dateien. In der einen Datei ist eine große Abzugsliste (ca. 20.000 Zeilen, 400 Spalten). In der anderen sind für eine unsortierbare Teilmenge der Abzugsliste Zusatzinformationen vorhanden.
Diese sollen nun anhand einer ID gematcht werden und den jeweiligen gefundenen Zeilen zugeordnet werden. Die Spalten der Zweitdatei werden ans Ende der Tabelle angehängt und für Nicht-Treffer leergelassen.
Mein geschriebener Code funktioniert im Ergebnis prächtig, dauert allerdings gute 6-7 Minuten.
Eventuell habe ich mich unnötig kompliziert verhalten. Es wäre toll, wenn irgendwer eine Idee hat, um da mehr Effizienz reinzubringen.
Danke euch!!
Gruß
Benni
Public Sub suchen_und_kopieren()
quell_lastcol = wb2.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
col_wb2_id = -1
For quell_col = 1 To quell_lastcol
Select Case LCase(wb2.Worksheets(1).Cells(1, quell_col))
Case LCase("Acc-ID"): col_wb2_id = quell_col
End Select
Next quell_col
If col_wb2_id = -1 Then
MsgBox "Spaltenname konnte nicht gefunden werden."
Exit Sub
End If
'Kopier-Vorgang
quell_lastrow = wb2.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ziel_lastcol = ziel_ws.Cells(10, Columns.Count).End(xlToLeft).Column
ziel_lastrow = ziel_ws.Cells(Rows.Count, 1).End(xlUp).Row
ziel_col = ziel_lastcol + 1
Spaltenbezeichnungen kopieren
quell_row = 1
For quell_col = 1 To quell_lastcol
wb2.Worksheets(1).Cells(quell_row, quell_col).Copy Destination:=ziel_ws.Cells(10, _
ziel_col)
ziel_col = ziel_col + 1
Next quell_col
Inhalte kopieren
ziel_col = ziel_lastcol + 1
For quell_row = 2 To quell_lastrow
For ziel_row = 11 To ziel_lastrow
Select Case ziel_ws.Cells(ziel_row, 1)
Case wb2.Worksheets(1).Cells(quell_row, col_wb2_id):
For quell_col = 1 To quell_lastcol
wb2.Worksheets(1).Cells(quell_row, quell_col).Copy Destination:=ziel_ws. _
Cells(ziel_row, ziel_col)
ziel_col = ziel_col + 1
Next quell_col
End Select
ziel_col = ziel_lastcol + 1
Next ziel_row
Next quell_row
End Sub