Wert aus anderer Tabelle holen

Question

Hallo,

ich schon wieder - diese Tabelle macht mich so langsam "wahnsinnig" .... ich habe nämlich schon wieder ein Problem, folgendes:

Ich möchte zwecks Auswertung Daten aus anderen Tabellen in die Tabelle AUSWERTUNG holen,

In der Tabelle AUSWERTUNG befindet sich in
A9 die Zahl 1, in
A10 die Zahl 2,
usw.
es existierten in dem Ordnder User1 Tabellen, die heissen
1.xls,
2.xls,
usw..

Folgende Fomel funktioniert, erschwert mir aber die Arbeit sehr, da ich [1.xls] per Hand für die weiter unten stehenden Auswertungen ändern muss.

=WENN($A9="";0;WENN(UND($E$3='C:\..\..\..\..\..\..\User1.\[1.xls]Auswertung'!$A$8;$A9='C:\..\..\..\..\..\..\User1\[1.xls]Auswertung'!$E$3);'C:\..\..\..\..\..\..\User1\[1.xls]Auswertung'!$B$8))

Das heißt, ich möchte [1.xls] variabel halten, so dass beim kopieren der Formel nach unten die 1 hochzählt.

Ich habe bereits diverse Varianten ausprobiert,
\ZEILE()-8"!A1"&".xls"
\"$A9"&".xls"
mal mit runder, mal mit eckiger Klammer, mal mit Anführungszeichen oder mit Hochstrich ... leider ohne Erfolg.
Ich erhalte stets einen #BEZUG - Fehler.

Was kann ich statt [1.xls] einsetzen, so dass die Fomel funktioniert???

Hoffe auf Anregungen, viele Grüße
Petra

Answer 1

hi petra ^^

richtig erkannt

an 2 stellen ist der pfad

C:\Temp3\

durch deinen zu ersetzen

Zieltabelle wie Quelltabelle
ist durch deine tabellennamen zu ersetzen

ausserdem in der zeile

TabellenNamen durch deinen tabellennamen ersetzen

LZeile = ThisWorkbook.Worksheets("TabellenNamen").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

Answer 2

hi petra ^^

jetzt noch 2 pfade aendern :-))

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim LZeile As Long
Dim SHerfassung As Integer, AIndex As Integer, EIndex As Integer
Dim DateiName As String, Meldung As String
DateiName = Dir("C:\Temp3\" & "*.xls")
EIndex = 9
AIndex = 8
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp3\" & DateiName
LZeile = ThisWorkbook.Worksheets("2008").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
ThisWorkbook.Worksheets("2008").Range("A" & LZeile) = Workbooks(DateiName).Worksheets("Auswertung").Range("D" & EIndex)
ThisWorkbook.Worksheets("2008").Range("B" & LZeile) = Workbooks(DateiName).Worksheets("Auswertung").Range("E" & EIndex)
ThisWorkbook.Worksheets("2008").Range("C" & LZeile) = Workbooks(DateiName).Worksheets("Auswertung").Range("F" & EIndex)
ThisWorkbook.Worksheets("2008").Range("D" & LZeile) = Workbooks(DateiName).Worksheets("Auswertung").Range("B" & AIndex)
ThisWorkbook.Worksheets("2008").Range("E" & LZeile) = Workbooks(DateiName).Worksheets("Auswertung").Range("C" & AIndex)
ThisWorkbook.Worksheets("2008").Range("F" & LZeile) = Workbooks(DateiName).Worksheets("Auswertung").Range("D" & AIndex)
EIndex = EIndex + 1
AIndex = AIndex + 1
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Answer 3

hi all ^^

das kann noch gelöscht werden,altlasten :-))

, Meldung As String

gruss nighty

Answer 4

Hallo Petra,
ich habe die Datei: Auswertung jetzt angepasst.
Der Pfad muß natürlich geändert werden.
Die Quelldateien müssen nicht geöffnet sein.
Erklärungen findest du im Code.
Ich hoffe du kommst damit klar.

Gruß
fedjo

Answer 5

Hallo,

vielen Dank erstmal für Eure Hilfe ... :-)

@nighty: ich bekomme das Makro einfach nicht zum laufen, ich bekomme aber auch keine Fehlermeldung ;-(

@fedjo
Makro funktioniert, allerdings fehlt mir hier die Schleife, da in dem Ordner diverse Tabellen (zurzeit 107) vorhanden sind .. und es werden täglich mehr. Kann man das mit Do while lösen?

Viele Grüße
Petra

Answer 6

Guten morgen,

ich habs ;-))))))))))

Habe mir nun aus allen Antworten einen Code zusammengebastelt - dieser funktioniert (so hoffe ich) tadellos.

Super, vielen, vielen Dank für Eure Hilfe

Viele Grüße - Petra


Private z!

Sub AuswertungenUebertragen2008()
Dim Laufwerk$, Dateien$
z = 9 'Erste Eintrag Zeile 9
z1 = 4 'Erster Eintrag Spalte 4
[d9:f200] = "" 'Alte Eintragungen löschen
Laufwerk = "C:\Users\Petra\Documents\...\User1"
Dateien = "*xls*"
Dateisuche Laufwerk, Dateien
Application.StatusBar = False
End Sub

Sub Dateisuche(Laufwerk, Dateien)
Dim tmp, Wdhlg
On Error Resume Next
If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
tmp = Dir(Laufwerk & Dateien)
Do While Len(tmp)
Cells(z & z1, 4).Formula = "='" & Pfad(Laufwerk & tmp) & "[" & Datei(Laufwerk & tmp) & "]" & "Auswertung" & "'!" & "B8"
Cells(z & z1, 5).Formula = "='" & Pfad(Laufwerk & tmp) & "[" & Datei(Laufwerk & tmp) & "]" & "Auswertung" & "'!" & "C8"
Cells(z & z1, 6).Formula = "='" & Pfad(Laufwerk & tmp) & "[" & Datei(Laufwerk & tmp) & "]" & "Auswertung" & "'!" & "D8"
z = z + 1
tmp = Dir()
Loop
tmp = Dir(Laufwerk, vbDirectory)
Do While Len(tmp)
Application.StatusBar = Laufwerk & tmp
If (tmp <> ".") And (tmp <> "..") Then
If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then
Dateisuche Laufwerk & tmp, Dateien
z = z - 1
Wdhlg = Dir(Laufwerk, vbDirectory)
z = z + 1
Do While Wdhlg <> tmp
Wdhlg = Dir()
Loop
End If
End If
tmp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
End Sub

Function Datei(Wert As String) As String
Do While InStr(Wert, "\") <> 0
Wert = Right(Wert, Len(Wert) - InStr(Wert, "\"))
Loop
Datei = Wert
End Function

Function Pfad(Wert As String) As String
Dim wert1$
wert1 = Wert
Do While InStr(wert1, "\") <> 0
wert1 = Right(wert1, Len(wert1) - InStr(wert1, "\"))
Loop
Pfad = Left(Wert, Len(Wert) - Len(wert1))
End Function