Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender Navigationstipps
Inhaltsverzeichnis

Sverweis über mehrere Arbeitsblätter

Sverweis über mehrere Arbeitsblätter
08.09.2008 14:21:00
Roland
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

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

Betreff
Datum
Anwender
Anzeige
AW: Sverweis über mehrere Arbeitsblätter
08.09.2008 14:56:00
Rudi
Hallo,
ohne Makro.
in Datei1 B1:
=sverweis($a1;indirekt("'[Sheet_600.xls]Sheet " &spalte(a1) &"'!A:B");2;)
nach rechts (bis H) und unten kopieren. Alles markieren, Bearbeiten-Inhalte einfügen-Werte.
Bearbeiten-Gehe Zu-Inhalte-Konstanten-Fehler. Die Zellen löschen (strg -) und dabei nach links verschieben. Fertig.
Datei2 muss geöffnet sein.
Gruß
Rudi
AW: Sverweis über mehrere Arbeitsblätter
08.09.2008 15:35:00
Roland
Sorry Rudi,
hab das jetzt mit 5.000 Einträgen probiert und Excel ist abgeschmiert.
Funktioniert leider nicht.
Bei meiner Formel dauert die Abfrage ca. 6 Minuten bei 10.000 Einträgen.
Hat noch jemand eine Idee.
Gruß
Roland
Anzeige
AW: Sverweis über mehrere Arbeitsblätter
09.09.2008 16:38:00
David
Da ich keine Lust habe, deine Dateien nachzubauen, kannst du eine abgespeckte Version hochladen?
Gruß
David

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige