Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1680to1684
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
Suchen und Kopieren
20.03.2019 16:27:55
Benni
Hallo zusammen,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen und Kopieren
20.03.2019 16:29:08
Hajo_Zi
warum nicht Sverweis()?

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
AW: Suchen und Kopieren
20.03.2019 17:36:32
Benni
Weil sich Spaltenanzahlen, Sortierung, Dateinamen, Worksheetnamen etc. durchgehend ändern können mit jedem Tag. Wenn ich dann einen Sverweis code-mäßig umsetzen würde, würde es wesentlich komplizierter werden als dieser Code, der ja logisch sehr einfach aufgebaut ist und halt definitiv funktioniert.
Da dieses Makro von vielen Leuten benutzt wird, soll nicht jeder anfangen, manuell mit Formeln zu experimentieren, sondern mit einem Klick alles erledigt sein.
Deswegen lieber eine Suche-und-Finde-Logik, die verständlich ist, sollte jemand anderes mal in den Code reinschauen müssen.
Gruß
Benni
Anzeige
AW: Suchen und Kopieren
21.03.2019 08:45:21
{Boris}
Hi,
nur grundsätzlich: Das Kopieren von Zellen dauert deutlich länger als nur das Zuweisen von Werten.
Wenn aber kopiert werden muss, schau Dir mal GetMoreSpeed an:
Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
Static intCalculation As Integer
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub
VG, Boris

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige