Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
912to916
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
912to916
912to916
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabelle Aufgrund von/bis Datum (Periodebereich)

Tabelle Aufgrund von/bis Datum (Periodebereich)
03.10.2007 23:46:00
Robert
Guten Abend Leute,
Hoffentlich könnt ihr mich mit folgender Sache helfen.
Ich möchte mit VBA erreichen dass wenn ich in Zelle A1 ein Datum (Periode Start), Zelle A2 (Periode Ende) und in A3 einen ID eingebe, eine neue Tabelle Aufgrund Daten in Tabelle1 erstellt wird.
Eingabe z.B. Periode Start: 01.01.2007
Periode Ende: 31.12.2007
ID: BBB
Die Zeilen mit ID „BBB“ wo sich der START und/oder ENDDATUM in Tabelle1
mit dem Periodebereich überschneiden sollten in einer neuen Tabelle eingefügt werden.
Tabelle1
Siehe Word.doc
https://www.herber.de/bbs/user/46516.doc
Ich hätte gerne dass die Tabelle2 dann in etwa so aussieht:
Siehe Word.doc
https://www.herber.de/bbs/user/46516.doc
In Spalte A sollte der Periode Bereich abgebildet werden. In Zeile 20
hätte ich gerne alle Typen die eine Überschneidung mit dem Periodenbereich haben.
Sieht ihr da eine Möglichkeit? Freue mich auf Hilfe da ich sonst nicht mehr weiter komme.
Gruss, Robert

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle Aufgrund von/bis Datum (Periodebereich)
04.10.2007 15:21:00
fcs
Hallo Robert,
Möglichkeiten gibt es fast immer und eine "halbwegs saubere" Tabelle Datenmäßig zu zerpflücken/aufzubröseln ist eigentlich immer eine Fleißaufgabe. Nachfolgend ein paar Prozeduren , die die Daten in etwa in der gewünschten Form darstellen.
Ich weiss ja nicht für welche Zwecke du die Daten in der gewünschten Form Darstellen willst. Reicht da die Auswertung der Daten per Pivot-Tabellenbericht nicht. Hier fehlen dann halt die regelmäßigen Monats-Abstände in den Zeilen, ansonsten hat manda auch schnell einen Datenüberblick.
Gruß
Franz

Option Explicit
Sub Schaltfläche2_BeiKlick()
'Wertetabelle aufbauen
Dim tStart As Date, tEnde As Date, lZeileDatum As Long
Dim wks As Worksheet
Dim iSpalte As Integer, lZeile As Long, Monat As Integer, iI%
Dim wksDaten As Worksheet
Dim boVorhanden As Boolean
Dim strID As String, strTyp As String, strTypNeu As String
Const lZ_Start As Long = 20 'Zeile mit Typ-Einträgen
Const iSpStart As Integer = 1 'Spalte mit Datums-Einträgen
Set wksDaten = Worksheets("Tabelle1")
Set wks = Worksheets("Tabelle2")
'Vorgabewerte einlesen
tStart = wks.Range("A1")
tEnde = wks.Range("A2")
strID = wks.Range("A3")
With wks
'Alteinträge Löschen
lZeile = .Cells(.Rows.Count, iSpStart).End(xlUp).Row
If lZeile > lZ_Start Then
.Range(.Rows(lZ_Start + iSpStart), .Rows(lZeile)).Clear
End If
iSpalte = .Cells(lZ_Start, .Columns.Count).End(xlToLeft).Column
If iSpalte > iSpStart Then
.Range(.Cells(lZ_Start, iSpStart + 1), .Cells(lZ_Start, iSpalte)).Clear
End If
'Datumseinträge (jeweils der Monatsletzte)
lZeile = lZ_Start
For Monat = 1 To (Year(tEnde) - Year(tStart)) * 12 + Month(tEnde) - Month(tStart) + 1
lZeile = lZeile + 1
.Cells(lZeile, iSpStart).NumberFormat = "DD.MM.YYYY"
.Cells(lZeile, iSpStart).Value = DateSerial(Year(tStart), _
Month(tStart) + Monat, 1) - 1
Next
'Typeinträge
iSpalte = iSpStart + 1
For lZeile = 2 To wksDaten.Cells(.Rows.Count, 1).End(xlUp).Row
If wksDaten.Cells(lZeile, 1).Value = strID Then
If DatumsCheck(Start:=wksDaten.Cells(lZeile, 2), _
Ende:=IIf(IsEmpty(wksDaten.Cells(lZeile, 3)), tEnde, _
wksDaten.Cells(lZeile, 3)), _
PeriodeStart:=tStart, PeriodeEnde:=tEnde) = True Then
strTypNeu = wksDaten.Cells(lZeile, 4).Value
If IsEmpty(.Cells(lZ_Start, iSpalte)) Then
.Cells(lZ_Start, iSpalte).NumberFormat = "@"
.Cells(lZ_Start, iSpalte) = strTypNeu
Else
boVorhanden = False
For iI = iSpStart + 1 To iSpalte
If strTypNeu = .Cells(lZ_Start, iI) Then
boVorhanden = True
Exit For
End If
Next
If boVorhanden = False Then
iSpalte = iSpalte + 1
.Cells(lZ_Start, iSpalte).NumberFormat = "@"
.Cells(lZ_Start, iSpalte) = strTypNeu
End If
End If
End If
End If
Next
'Typeinträge sortieren
.Range(.Cells(lZ_Start, iSpStart + 1), .Cells(lZ_Start, iSpalte)).Sort _
Key1:=.Cells(lZ_Start, iSpStart + 1), Order1:=xlAscending, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
'Format für Werte aus Datentabelle übernehmen
.Range(.Cells(lZ_Start + 1, iSpStart + 1), .Cells(.Rows.Count, _
iSpStart).End(xlUp).Offset(0, iSpalte - iSpStart)).NumberFormat _
= wksDaten.Cells(2, 5).NumberFormat
'Werte einsortieren entsprechend Datumsbereich und Typ
For lZeile = 2 To wksDaten.Cells(.Rows.Count, 1).End(xlUp).Row
If wksDaten.Cells(lZeile, 1).Value = strID Then
For lZeileDatum = lZ_Start + 1 To .Cells(.Rows.Count, iSpStart).End(xlUp).Row
If DatumsCheck2(Start:=wksDaten.Cells(lZeile, 2), _
Ende:=IIf(IsEmpty(wksDaten.Cells(lZeile, 3)), tEnde, _
wksDaten.Cells(lZeile, 3)), _
Stichtag:=.Cells(lZeileDatum, iSpStart).Value) = True Then
strTypNeu = wksDaten.Cells(lZeile, 4).Value
For iI = iSpStart + 1 To iSpalte
If strTypNeu = .Cells(lZ_Start, iI) Then
.Cells(lZeileDatum, iI) = wksDaten.Cells(lZeile, 5).Value
End If
Next
End If
Next
End If
Next
End With
End Sub
Function DatumsCheck(Start As Date, Ende As Date, PeriodeStart As Date, _
PeriodeEnde As Date) As Boolean
'Überprüfen, ob Start und/oder Ende in die Periode fallen (inklusive Grenzen)
If Start = PeriodeStart Then
DatumsCheck = True
End If
End Function
Function DatumsCheck2(Start As Date, Ende As Date, Stichtag As Date) As Boolean
'Überprüfen, ob Stichtag innerhalb von Start und Ende fällt (inklusive Grenzen)
If Stichtag >= Start And Stichtag 


Anzeige
AW: Tabelle Aufgrund von/bis Datum (Periodebereich)
04.10.2007 19:26:18
Robert
Hallo Franz,
Vielen Dank! Dein Code beantwortet meine Frage. Die Zwecke? Also, ich bekomme jede Monat neue Daten(Indices und Werte). Anhand deines Codes kann ich die Gewichtung von Indices im Portfolio berechnen. In mein Beispiel stehen die % Zahlen für monatliche Gewichtung. So bald die Gewichtungstabelle steht, laufen weitere vba Codes die die monatliche oder halt periodische Portfolio Performance vom portfolio Gegenüber Benchmark berechnen. Dein Code muss ich für meine Zwecke anpassen aber dass werde ich ohne Probleme hinbekommen. Einfach Top, Franz!
Gruss, Robert

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige