Hallo Herbianer,
ich mach hier nur noch mal einen neuen Thread auf, da ich vorhin vergessen habe meine Email zu vervollständigen.
Hier noch mal das Grundproblem:
In einer Datei 1 stehen verschiedene Artikelnummern (zwischen 2.000 und 20.000). In einer anderen Datei 2 stehen dazu Stammdaten. Diese Datei 2 enthält aber ca. 360.000 Artikel. Nun möchte ich automatisch eine Abfage über mehrere Arbeitsblätter starten, sodass den Artikelnummern in Datei 1 die Satmmdaten aus Datei 2 zugewiesen werden.
Ich hab das Ganze jetzt wie unten beschrieben gelöst.
Jetzt geht die Abfrage bis zu einer gewissen Größe zwar super, aber ab 5.000 gesuchten Zahlen wirds dann extremst langsam bzw. stürzt Excel komplett ab.
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 1'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 2'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 3'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 4'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 5'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 6'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Sheet_600.xls]Sheet 7'!R1:R65536,2,FALSE)"
Range("A1").End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
End Sub
Ich kopiere den Sverweis für Arbeitsblatt 1 erst in alle benötigten Zellen, lösche dann die Zellen in denen kein Ergebnis gefunden wurde, sortiere aufsteigend und fange bei der ersten leeren Zelle von unten wieder an den Sverweis für Tabellenblatt 2 einzufügen usw.
Kann mir jemand verraten, ob es hierfür eine bessere Lösung gibt oder wie ich mein VBA-Code evtl. schneller mache.
Wäre für jede Hilfe dankbar.
Roland