Daten aus geschlossener Datei auslesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi R.,
ich hab mal mehrere Tipps für Dich:
1.) Deine Beispieldatei ist 510 KB groß, obwohl sie eigentlich nur 84 Zeilen hat.
Markiere mal die Zeilen 85 bis 65536, rechte Maustaste, Zellen löschen. Dann Datei sofort speichern.
Jetzt ist sie nur noch schlappe 19 KB groß.
2.)
Deine Artikelnummern sind - aus welchem Grund auch immer - Text (obwohl Zellformat "Standard"). Das ist mir bei der noch folgenden Formellösung aufgefallen.
Mach daraus mal eine Zahl, indem du eine leere Zelle kopierst, die gesamte Spalte A (mit den Artikelnummern) markierst, rechte Maustaste, Inhalte einfügen, Haken bei Addieren, und ok.
Jetzt sind es wieder Zahlen (auch daran zu erkennen, dass sie in der Zelle rechtsbündig stehen).
3.) Zu der eigentlichen Lösung:
In die neue Datei schreibst du in A1 die gewünschte Artikelnummer.
Dann in A2 folgende Array-Formel:
{=WENN(ZEILE($A1)&gtSUMME(N('C:\[Artikeldaten2.xls]Tabelle1'!$A$1:$A$84=$A$1));"";INDEX('C:\[Artikeldaten2.xls]Tabelle1'!B:B;KKLEINSTE(WENN('C:\[Artikeldaten2.xls]Tabelle1'!$A$1:$A$84=$A$1;ZEILE($1:$84));ZEILE($A1))))}
(Ich hab die Datei "Artikeldaten2.xls" mal direkt auf C: gespeichert - das musst du natürlich bei dir anpassen)
Die {geschweiften Klammern} gibst du nicht mit ein. Stattdessen schließe die Formeleingabe mit Strg-Shift-Enter ab (statt mit Enter allein). So werden sie automatisch erzeugt.
Diese Formel aus A2 kopierst du jetzt nach rechts bis D2 und dann alle Formeln soweit runter, wie maximal Treffer vorkommen können (kommt kein Treffer mehr vor, bleiben die Zellen leer).
Ich hab das jetzt mal bis Zeile 84 geschrieben - das musst du in der Formel ggfls. erweitern.
Aber Achtung: Die Arrayformeln sind sehr rechenintensiv. Wähle alle Bereich nur so groß wie gerade eben nötig - sonst geht dir die Performance fliegen.
Grüße Boris

Dank´dir Boris,
so oder zumindest so ähnlich hatte ich es auch schon
angegangen. Für das Textformat in der Datei bitte ich
um Nachsicht. (ist nur ein entfremdeter Ausriß aus der
Originalliste und wohl beim Erstellen von Artikeldaten2
passiert)
Mein Problem ist genau der von dir angesprochene Bereich
und seine Größe.
Ich habe solche Artikellisten (von A1 bis Q40.000) nämlich
gleich 10x in einer Datei mit Namen "Daten". Auf diese Daten
soll nun niemand direkt Zugriff haben, desswegen ist sie
auch passwordgeschützt.
Mit einer Pivot wollte ich immer nur die Zahlen auslesen
auf die der Anwender (nach Einwahl durch PIN identifiziert)
Zugriff hat.
Der Leiter der Zweigstelle A hat nach Eingabe seiner Pin
auch nur Zugriff auf die Daten im Arbeitsblatt A von "Daten".
B nur auf B und so weiter.
Um die Auswertungsdatei etwas "geschmeidiger" zu machen, hatte
ich vor, nur jeweils die Daten aus "Daten" in meine Auswertungs-
datei (als Quelle der Pivottabelle dort)zu laden, für die der
Anwender berechtigt ist und die er auch gerade sehen will.
MS Query geht nicht - weil bei uns noch welche mit Version ´97
rumturnen.
Klar kann man jedesmal "Daten" aufmachen und die benötigten
Infos mittels Autofilter und Verweis auf das entsprechende Blatt
in die Auswertungsdatei holen.
Aber genau das ist es, was ich umgehen will. Denn Öffnen, Autofilter
Copy/Paste etc. braucht ja auch nicht wenig Zeit.
Auch konsolidierte Pivots mit mehreren Bereichen gehen mir nach
dem fünften Arbeitsblatt in die Knie : Performance = NULL.
Mit deiner Formel muß ich jeweils den ganzen Bereich A1 bis Q40000
abgrasen und habe im Zweifelsfall 38.000 leere Zeilen und bunt verstreut
meine 2.000 gesuchten vollen Zeilen bunt verstreut in A1:Q40.000.
Doch wie diese immer ganz oben stehen haben ?
Vielen Dank jedenfalls
R.Schmitt

Option Explicit Sub machs() Dim C As Range, rngArtikel As Range, lRow As Long Dim wbArtikel As Workbook, firstAddr As String Application.ScreenUpdating = False Set wbArtikel = GetObject("C:\Artikeldaten2.xls") 'Pfad anpassen!!! Set rngArtikel = [a1] 'Suchbegriff = Artikelnummer lRow = 2 'Startzeile für die Ausgabe With wbArtikel.Worksheets("Tabelle1").Range("A:A") Set C = .Find(rngArtikel, lookat:=xlWhole) Rows("2:65536").Clear 'Ausgabebereich leeren If Not C Is Nothing Then firstAddr = C.Address Do Cells(lRow, 1) = C.Offset(0, 1) Cells(lRow, 2) = C.Offset(0, 2) Cells(lRow, 3) = C.Offset(0, 3) Cells(lRow, 4) = C.Offset(0, 4) lRow = lRow + 1 Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> firstAddr Else MsgBox "Artikelnummer " & rngArtikel & " nicht gefunden.", , "Fehlanzeige..." End If End With wbArtikel.Close Set wbArtikel = Nothing Application.ScreenUpdating = True End Sub

Option Explicit Sub machs() Dim C As Range, rngArtikel As Range, lRow As Long Dim wbArtikel As Workbook, firstAddr As String Application.ScreenUpdating = False Set wbArtikel = GetObject("C:\Artikeldaten2.xls") Set rngArtikel = [a1] 'Suchbegriff = Artikelnummer lRow = 2 'Startzeile für die Ausgabe With wbArtikel.Worksheets("Tabelle1").Range("A:A") Set C = .Find(rngArtikel, lookat:=xlWhole) Rows("2:65536").Clear 'Ausgabebereich leeren If Not C Is Nothing Then firstAddr = C.Address Do Range(Cells(lRow, 1), Cells(lRow, 4)) = C.Offset(0, 1).Resize(1, 4).Value lRow = lRow + 1 Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> firstAddr Else MsgBox "Artikelnummer " & rngArtikel & " nicht gefunden.", , "Fehlanzeige..." End If End With wbArtikel.Close Set wbArtikel = Nothing Application.ScreenUpdating = True End Sub

Option Explicit Sub Artikel_auflisten() Dim C As Range, rngArtikel As Range, lRow As Long Dim wbArtikel As Workbook, firstAddr As String Dim wsArtikel As Worksheet Dim wbZiel As Workbook, wsZiel As Worksheet, rngSuch As Range Application.ScreenUpdating = False Set wbArtikel = GetObject("C:\Artikeldaten2.xls") 'Quelldatei Set wsArtikel = wbArtikel.Worksheets("Tabelle1") 'Blatt in Quelldatei Set rngSuch = wsArtikel.[a:a] 'Suchbereich im Blatt der Quelldatei - hier: Spalte A Set wbZiel = ThisWorkbook 'Zieldatei Set wsZiel = wbZiel.Worksheets("Tabelle1") 'Blatt in Zieldatei With wsZiel Set rngArtikel = .[a1] 'Suchbegriff = Artikelnummer aus A1 des Blattes wsZiel lRow = 2 'Startzeile für die Ausgabe Set C = rngSuch.Find(rngArtikel, lookat:=xlWhole) .Rows("2:65536").Clear 'Ausgabebereich leeren If Not C Is Nothing Then firstAddr = C.Address Do .Range(.Cells(lRow, 1), .Cells(lRow, 4)) = C.Offset(0, 1).Resize(1, 4).Value lRow = lRow + 1 Set C = rngSuch.FindNext(C) Loop While Not C Is Nothing And C.Address <> firstAddr Else MsgBox "Artikelnummer " & rngArtikel & " nicht gefunden.", , "Fehlanzeige..." End If End With wbArtikel.Close Set rngSuch = Nothing Set wsArtikel = Nothing Set wbArtikel = Nothing Set wsZiel = Nothing Set wbZiel = Nothing Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Daten aus geschlossener Datei auslesen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

329 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus geschlossener Datei auslesen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

329 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread