AW: Vielen Dank und noch eine Ergänzungsfrage
21.02.2008 00:50:32
fcs
Hallo Bernd,
Frage1: Hierzu muss die Erhöhung des Zeilenzählers für ZeileZiel angepasst werden. Im nacfolgenden Code hab ich die zu ändernden/einzufügenden Zeilen markiert.
Frage2: Wenn du die Daten im Bereich I bis P mit den Daten des bereichs B bis H 10 Datensätze weiter oben vergleichen willst, dann kannst du das in den Spalten ab Q in Zeile 12 und folgende per Formel machen oder auch per Makro (siehe Ergänzung am Ende des Code-Beispiels).
Der Vergleich mit einem 10 besser 14 Tage zurückliegendem Datum ist eigentlich nur per Makro zu bewältigen, da durch fehlende Wochenendtage unterschiedlich viele Zeilen zwischen den zu vergleichenden Daten liegen können; ggf. kommt man hier aber auch mit der SVERWEIS-Funktion weiter, aber das wird relativ kompliziert, da auch auf fehlendes Datum geprüft werden muss.
Frage 3: Was meinst du mit "Links anzeigen"?
Den Namen der Datei aus der die Daten für den jeweiligen Tag eingelesen wurden?
Das ist prinzipiell möglich. Hinter der Zeile, in der das Datum in die Zieltabelle geschrieben _
wird kannst du auch den Pfad+Namen der Quelldatei ins Zielblatt schreiben. Beispiel:
'Datum in Spalte 1 eintragen
.Cells(Zeile_B_H, 1).Value = Datum '######## ändern
'Pfad und Name der Quelldatei in Spalte Q eintragen
.Cells(Zeile_B_H, 17).Value = wbQuelle.FullName
In ähnlicher Weise kannst du den Namen der 2. Quelldatei im 2. Code-Teile eintragen
Gruß
Franz
Sub DatenEinlesen()
Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZiel As Long, SpalteZiel As Integer
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim strQuelle As String, strProdukt As Variant, Zelle As Range, strPfadQuellen As String
Dim DatumStart As Date, DatumEnde As Date, Datum As Date
Dim Zeile_B_H As Long, Zeile_I_P As Long '######## Zeile einfügen
Eingabe1:
Eingabe = InputBox("Bitte Startdatum eingeben", "Tagesdaten-Import", _
"1.1." & Year(Date))
If Eingabe = "" Then Exit Sub
If IsDate(Eingabe) Then
DatumStart = CDate(Eingabe)
Else
MsgBox "Eingabe ist kein gültiges Datum, Eingabe wiederholen!"
GoTo Eingabe1
End If
Eingabe2:
Eingabe = InputBox("Bitte Enddatum eingeben", "Tagesdaten-Import", _
Format(Date - 1, "D.M.YYYY"))
If Eingabe = "" Then Exit Sub
If IsDate(Eingabe) Then
DatumEnde = CDate(Eingabe)
Else
MsgBox "Eingabe ist kein gültiges Datum, Eingabe wiederholen!"
GoTo Eingabe2
End If
Set wbZiel = ThisWorkbook
Set wksZiel = wbZiel.Worksheets(1)
'Zeile mit Startdatum suchen
With wksZiel
'Startzeile in Zieltabelle ermitteln (nächste Leere in Spalte A)
ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Application.ScreenUpdating = False
For Datum = DatumStart To DatumEnde
Zeile_B_H = ZeileZiel '######## Zeile einfügen
Zeile_I_P = ZeileZiel '######## Zeile einfügen
'Tages-Daten für Produkte in Spalten B bis H einlesen
'Name der Quelldatei
'Basisverzeichnis der Tagesdateien
strPfadQuellen = "C:\Lokale daten\Test\" '###anpassen!!
'Pfad + Dateiname der Quell-Datei berechnen
strQuelle = strPfadQuellen & Year(Datum) & "_" & Format(Datum, "MM") & "\" _
& Format(Datum, "DD") & "\" & "Tageswerte.xls"
'Prüfen ob Quelldatei vorhanden
If Dir(strQuelle) "" Then
'Quelldatei öffnen und Quellblatt zuweisen
Set wbQuelle = Workbooks.Open(Filename:=strQuelle, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets("Einzelwerte")
'Datum in Spalte 1 eintragen
.Cells(Zeile_B_H, 1).Value = Datum '######## ändern
'Produktnamen in Zeile 1 abarbeiten
For SpalteZiel = 2 To 8
strProdukt = .Cells(1, SpalteZiel).Text
'Produkt in Quelle spalte 1 suchen
Set Zelle = wksQuelle.Columns(1).Find(what:=strProdukt, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle Is Nothing Then
'Nullwert eintragen wenn Produkt nicht vorhanden
.Cells(Zeile_B_H, SpalteZiel).Value = 0 '######## ändern
Else
'Werte aus Spalte B für Produkt eintragen
.Cells(Zeile_B_H, SpalteZiel).Value = Zelle.Offset(0, 1).Value '######## ändern
End If
Next
wbQuelle.Close savechanges:=False
ZeileZiel = Zeile_B_H + 1 '######## ändern
Else
'Die folgende Zeile in eine Bemerkung umwandeln, wenn alles funktioniert
MsgBox "Quelldatei für Datum """ & Format(Datum, "DD.MM.YYYY") _
& """ ist nicht vorhanden." & vbLf & vbLf _
& "Dateiname wäre: " & strQuelle
End If
'Daten für Produkte in Spalten I bis P einlesen
'Name der Quelldatei
'Basisverzeichnis der Tagesdateien
strPfadQuellen = "C:\Lokale daten\Test\" '###anpassen!!
'Pfad + Dateiname der Quell-Datei berechnen
strQuelle = strPfadQuellen & Year(Datum) & "_" & Format(Datum, "MM") & "\" _
& Format(Datum, "DD") & "\" & "Tageswerte.xls" '###ggf. Anpassen
'Prüfen ob Quelldatei vorhanden
If Dir(strQuelle) "" Then
'Quelldatei öffnen und Quellblatt zuweisen
Set wbQuelle = Workbooks.Open(Filename:=strQuelle, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets("Einzelwerte")
'Produktnamen in Zeile 1 der Zieltabelle abarbeiten
For SpalteZiel = 9 To 16
strProdukt = .Cells(1, SpalteZiel).Text
'Produkt in Quelle Zeile 1 suchen
Set Zelle = wksQuelle.Rows(1).Find(what:=strProdukt, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle Is Nothing Then
'Nullwert eintragen wenn Produkt nicht vorhanden
.Cells(Zeile_I_P, SpalteZiel).Value = 0 '######## ändern
Else
'Wert aus Zeile 2 für Produkt eintragen
.Cells(Zeile_I_P, SpalteZiel).Value = Zelle.Offset(1, 0).Value '######## ändern
End If
Next
wbQuelle.Close savechanges:=False
ZeileZiel = Zeile_I_P + 1 '######## diese Zeile einfügen
Else
'Die folgende Zeile in eine Bemerkung umwandeln, wenn alles funktioniert
MsgBox "Quelldatei für Spalte I bis P ist nicht vorhanden." & vbLf & vbLf _
& "Dateiname wäre: " & strQuelle
End If
' ZeileZiel = ZeileZiel + 1 '############ Diese Zeile löschen #######
Next Datum
'Vergleich der Daten Bereich I-P mit B-H 10 Zeilen oberhalb
With wksZiel
For ZeileZiel = 12 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Differenz Spalte I - Spalte B
.Cells(ZeileZiel, 19).Value = .Cells(ZeileZiel, 9).Value - .Cells(ZeileZiel - 10, 2)
'Differenz Spalte J - Spalte C
.Cells(ZeileZiel, 20).Value = .Cells(ZeileZiel, 10).Value - .Cells(ZeileZiel - 10, 3)
'u.s.w.
Next
End With
Application.ScreenUpdating = True
End With
Set Zelle = Nothing: Set wbQuelle = Nothing: Set wksQuelle = Nothing
Set wbZiel = Nothing: Set wksZiel = Nothing
End Sub