Hallo Leute,
Ich habe zwei recht große Tabellen (ca 55000 Zeilen und 100 Spalten, evtl. auch in zwei Mappen) bei denen ich vorher definierte Spalten ab einer vorher definierten Zeile vergleichen möchte. Sollten Übereinstimmungen gefunden werden möchte ich aus der Quelltabelle die Zeile ab der definierten Spalte in die Targettabelle neben die übereinstimmende Zelle kopieren (nur Werte und Formate). Die Zielspalte wird, wie alle anderen Variabelen, vorher über eine Inputbox abgefragt. Ich habe mich für eine Inputboxen statt einer Userform entschieden, da das Makro dann einfach in andere Mappen übertragen werden kann. Bei den zu kopierenden Zeilen muß nicht jede Zelle ausgefüllt sein. Daher habe ich die Variabele Ende1 (s. u.) eingeführt
Im Prinzip ist das nich viel anders als:
https://www.herber.de/forum/archiv/312to316/t312331.htm
Das Makro funktioniert bei mir nur leider nicht. Ich habe daher selbst etwas geschrieben. Ich habe aber das Gefühl, dass das nicht sonderlich effektiv ist. Es ist nicht wesentlich schneller als SVERWEIS. Kann mir jemand sagen wie ich das Makro effektiver machen kann? Ich habe den wesentlichen Teil unten angehängt.
Merge:
Workbooks(varBookTarget).Activate
Worksheets(varSheetTarget).Activate
Range(varColTarget & varRowTarget).Activate
x = -1
Workbooks(varBookSour).Worksheets(varSheetSour).Activate
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
Ende1 = ActiveCell.Column
Application.ScreenUpdating = False
Von_Vorne:
x = x + 1
varInput = Sheets(varSheetTarget).Range(varColTarget & varRowTarget + x).Value
Do Until IsEmpty(varInput)
Set Found = Workbooks(varBookSour).Worksheets(varSheetSour). _
Columns(varColSour).Find(What:=varInput, LookAt:=xlWhole, LookIn:=xlValues)
If Found Is Nothing Then
GoTo Von_Vorne
Exit Sub
End If
FoundA = Found.Row
FoundC = Found.Column
StartA = Cells(FoundA, FoundC).Address(False, False)
EndeA = Cells(FoundA, Ende1).Address
Workbooks(varBookSour).Worksheets(varSheetSour).Activate
Workbooks(varBookSour).Worksheets(varSheetSour).Range(StartA, EndeA).Copy
With Workbooks(varBookTarget).Worksheets(varSheetTarget). _
Range(varColTargetP & varRowTarget + x)
.PasteSpecial Paste:=xlValues ' Werte
.PasteSpecial Paste:=xlFormats ' Formate)
Application.CutCopyMode = False
End With
x = x + 1
varInput = Sheets(varSheetTarget).Range(varColTarget & varRowTarget + x).Value
Loop