AW: Werte aus mehreren Dateien auslesen
24.10.2007 13:03:00
Sebastian
Hallo Thomas!
Falls du noch mal kurz Zeit hättest, es hat sich irgendwo ein kleiner Bug eingeschlichen, und ich bin nicht von selbst drauf gekommen, woran das liegt. Die Fehlerbeschreibung ist wie folgt:
1. Bei der Auflistung der Daten sind teilweise Werte falsch. Nach Durchlauf der Prozedur erhalte ich zur Zeit:
16/7/2007
17/7/2007
18/7/2007
19/7/2007
20/7/2007
23/7/2007
24/7/2007
25/7/2007
26/7/2007
30/7/2007
31/7/2007
08/01/2007
08/02/2007
08/03/2007
08/06/2007
08/07/2007
08/08/2007
08/09/2007
08/10/2007
14/8/2007
15/8/2007
16/8/2007
17/8/2007
20/8/2007
21/8/2007
22/8/2007
23/8/2007
24/8/2007
27/8/2007
28/8/2007
29/8/2007
30/8/2007
31/8/2007
09/03/2007
09/04/2007
09/06/2007
09/07/2007
09/11/2007
09/12/2007
14/9/2007
18/9/2007
19/9/2007
20/9/2007
21/9/2007
24/9/2007
25/9/2007
26/9/2007
27/9/2007
30/9/2007
10/01/2007
10/02/2007
10/05/2007
10/08/2007
10/09/2007
10/10/2007
10/11/2007
10/12/2007
15/10/2007
16/10/2007
18/10/2007
19/10/2007
22/10/2007
23/10/2007
Bei den fettgedruckten Werten sind Tag und Monat vertauscht, es müsste also beispielsweise richtigerweise statt dem 08/01/2007 der 01/08/2007 ausgespuckt werden.
Mir ist aufgefallen, dass er diesen "Dreher" immer nach dem Ende des letzten Monats drin hat. Also nach dem 31/07, 31/08, 30/09 usw.
Außerdem ist mir aufgefallen, dass bei den richtigen Werten die Monate einstellig sind, bei den falschen hingegen eine 0 dabei steht. (Also z.b. Format "03/09" statt Format "31/7")
Das Format ist mir eigentlich egal, aber vielleicht hilft das ja bei der Identifikation des Fehlers. Wäre super dankbar für eine Hilfe.
P.S: Die angepasste Routine sieht im Moment so aus:
Sub sammelDaten()
Application.ScreenUpdating = False
Dim dasJahr As Integer, derMonat As Integer, derTag As Integer, i As Integer
Dim openfile As String, DatumSplitt As String
[A18].Select
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\TAP" 'ggf. anpassen
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
openfile = .FoundFiles(i)
Dim Bereich As Range
Set Bereich = Range("F41")
Workbooks.Open openfile
Sheets("Aus_Preis").Select
Bereich.Value = Range("F41").Value
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
DatumSplitt = Right(Left(openfile, Len(openfile) - 4), 8)
dasJahr = Left(DatumSplitt, 4)
derMonat = Left(Right(DatumSplitt, 4), 2)
derTag = Right(DatumSplitt, 2)
If Not ActiveCell = "" Then ActiveCell.Offset(1, 0).Select
ActiveCell = derTag & "/" & derMonat & "/" & dasJahr
ActiveCell.Offset(0, 1) = [F41]
[F41] = ""
Next i
Else
MsgBox "Keine Datei vorhanden."
End If
End With
Application.ScreenUpdating = True
End Sub
Vielen Dank und beste Grüße,
Sebastian