Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
19.04.2024 12:23:24
Wenn-Formel anpassen
19.04.2024 12:09:19
Unique (Application.WorksheetFunction.Unique)
19.04.2024 11:51:37
Nächsten identischen Treffer suchen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1284to1288
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1284to1288
1284to1288
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Monatsdaten wieder auseinander nehmen

Monatsdaten wieder auseinander nehmen
01.11.2012 21:36:25
Mexsalem
Hallo,
robert konnte mir netterweise bei dieser Frage helfen:
https://www.herber.de/forum/archiv/1280to1284/t1282308.htm#1282308
Er konnte ein Makro erstellen, dass mir einen Zahlungsstrom anhand des Datums zusammenfassen kann. Es sieht so aus (Beispielmappe siehe o.g. Link): 
Option Explicit
Sub tt()
Dim dstart As Date, estart As Date
Dim myrate As Long, datez As Long
Dim rngz As Long, x As Long, i As Long, zz As Long, nz As Long, endrate As Long
x = 2
zz = 2
rngz = 1
nz = 2
Application.ScreenUpdating = False
Range("E2:H1000").ClearContents
For i = nz To Cells(Rows.Count, 1).End(xlUp).Row
myrate = Cells(i, 3)
dstart = Cells(nz, 1)
If Cells(i + 1, 3) = Cells(i, 3) Then
endrate = endrate + myrate
rngz = rngz + 1
Else
Cells(zz, 5) = dstart
Cells(zz, 6) = Cells(i, 2)
Cells(zz, 7) = Cells(i, 3)
Cells(zz, 8) = rngz
zz = zz + 1
nz = i + 1
rngz = 1
End If
Next i
x = Cells(Rows.Count, 5).End(xlUp).Row
Cells(x + 2, 5) = Cells(2, 5)
Cells(x + 2, 6) = Cells(x, 6)
Cells(x + 2, 8) = Application.Sum(Range(Cells(2, 8), Cells(x, 8)))
Application.ScreenUpdating = True
End Sub
Nun möchte ich auch gerne den umgekehrten Weg, d.h. ich gebe eine Zusammenfassung vor und ein Makro soll mir den Zahlungsstrom erstellen. Die Laufzeiten varieren, d.h. die Zusammenfassung ist unterschiedlich lang (mal eine Zeile "von bis", mal x Zeilen).
Ausgangslage/Eingabe: 
   von	            bis 	  Rate	      Anzahl Monate
01.12.2012	31.12.2012	 100,00   	1
01.01.2013	30.04.2013	 200,00   	4
01.05.2013	30.09.2013	 500,00   	5
01.10.2013	28.02.2014	 5.000,00   	5
01.03.2014	31.10.2014	 2.500,00   	8


Gewünschtes Ergebnis : 
   von	           bis	          Rate
01.12.2012	31.12.2012	 100,00
01.01.2013	31.01.2013	 200,00
01.02.2013	28.02.2013	 200,00
01.03.2013	31.03.2013	 200,00
01.04.2013	30.04.2013	 200,00
01.05.2013	31.05.2013	 500,00
01.06.2013	30.06.2013	 500,00
01.07.2013	31.07.2013	 500,00
01.08.2013	31.08.2013	 500,00
01.09.2013	30.09.2013	 500,00
01.10.2013	31.10.2013	 5.000,00
01.11.2013	30.11.2013	 5.000,00
01.12.2013	31.12.2013	 5.000,00
01.01.2014	31.01.2014	 5.000,00
01.02.2014	28.02.2014	 5.000,00
01.03.2014	31.03.2014	 2.500,00
01.04.2014	30.04.2014	 2.500,00
01.05.2014	31.05.2014	 2.500,00
01.06.2014	30.06.2014	 2.500,00
01.07.2014	31.07.2014	 2.500,00
01.08.2014	31.08.2014	 2.500,00
01.09.2014	30.09.2014	 2.500,00
01.10.2014	31.10.2014	 2.500,00
Wie baue ich das Makro von robert um, damit es das kann ?
Grüße
Mexsalem

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 07:43:12
Tino
Hallo,
habe zwar den Code von robert nicht verwendet, aber vielleicht gehts mit diesem ja auch.
Ich gehe mal davon aus das die Daten auf der Tabelle1 ab A2 vorliegen,
sonst muss dies angepasst werden.
Die Ausgabe erfolgt auch auf Tabelle1 ab E1, muss evtl. auch angepasst werden.
Sub ListeGross()
Dim ArrData, ArrAus()
Dim n&, nn&, intDif%
Dim DateAnfang As Date, DateEnde As Date
Dim curRate As Currency

With Tabelle1 'Tabelle anpassen 
    With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
        ArrData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
    End With
End With
Redim Preserve ArrAus(1 To 3, 1 To 1)
For n = 1 To Ubound(ArrData)
    DateAnfang = ArrData(n, 1)
    DateEnde = ArrData(n, 2)
    curRate = ArrData(n, 3)
    intDif = DateDiff("m", DateAnfang, DateEnde) + 1
    Redim Preserve ArrAus(1 To 3, 1 To Ubound(ArrAus, 2) + intDif)
    Do While DateAnfang < DateEnde
        nn = nn + 1
        ArrAus(1, nn) = DateAnfang
        ArrAus(2, nn) = DateSerial(Year(DateAnfang), Month(DateAnfang) + 1, 0)
        ArrAus(3, nn) = curRate
        DateAnfang = DateSerial(Year(DateAnfang), Month(DateAnfang) + 1, 1)
    Loop
Next n
Call ArrayTranspose(ArrAus)

'Ausgabe ***************************** 
With Tabelle1 'Tabelle anpassen 
    'Überschrift 
    With .Range("E1").Resize(, 3)
        .Cells(1, 1) = "von"
        .Cells(1, 2) = "bis"
        .Cells(1, 3) = "Rate"
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    'Daten 
    With .Range("E2").Resize(nn, 3)
        .Columns(1).Resize(, 2).NumberFormat = "dd.mm.yyyy"
        .Columns(3).NumberFormat = "#,##0.00"
        .Value = ArrAus
        .EntireColumn.AutoFit
    End With
End With
End Sub

Sub ArrayTranspose(varArray)
Dim NewArr(), n&, nn&
Redim Preserve NewArr(1 To Ubound(varArray, 2), 1 To Ubound(varArray))
For n = 1 To Ubound(varArray, 2)
    For nn = 1 To Ubound(varArray)
        NewArr(n, nn) = varArray(nn, n)
    Next nn
Next n
varArray = NewArr
End Sub
Gruß Tino

Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 08:42:31
UweD
Hallo
hier ein Vorschlag von mir.
Sub Splitten_Datum()
On Error GoTo Fehler
Dim TB, i%, j%, Mon%, Von As Date
Dim Rate%, Neu As Date, LR&
Set TB = ActiveSheet
LR = TB.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
Application.ScreenUpdating = False
For i = LR To 2 Step -1
Von = TB.Cells(i, 1)
Mon = TB.Cells(i, 4) - 1
Rate = TB.Cells(i, 3)
If Mon > 1 Then
For j = Mon To 1 Step -1
TB.Rows(i + 1).Insert xlDown
Neu = DateSerial(Year(Von), Month(Von) + j, 1)
TB.Cells(i + 1, 1) = Neu
TB.Cells(i + 1, 2) = DateSerial(Year(Neu), Month(Neu) + 1, 0)
TB.Cells(i + 1, 3) = Rate
If j = 1 Then
TB.Cells(i, 2) = DateSerial(Year(Von), Month(Von) + 1, 0)
End If
Next j
End If
Next i
TB.Columns(4).ClearContents
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Gruß UweD

Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 21:43:11
Mexsalem
Hallo Tino, Hallo UweD,
zuerst einmal ein Danke für die Zeit, die Ihr heute morgen gleich in die Makros investiert habt. Der Code von Tino läuft bei mir leider auf folgende Fehlermeldung auf : 
Laufzeitfehler 458 :
Variable verwendet einen in Visual Basis nicht unterstützten Automatisierungstyp
Der Fehler läßt sich bei dieser Zeile im Sub ArrayTranspose(varArray) auslösen :
varArray = NewArr
Ich vermute, dass hängt viellicht mit der EXCEL 97-Version zusammmen, die ich noch verwende. Die VBA-Hilfe findet das Schlüsselwort varArray nicht. Oder fehlt hier eine Referenzierung ? Wenn ich Sub ArrayTranspose(ByRef varArray() As Variant)
 nehme kommt zumindest eine andere Fehlermeldung :-)
Fehler bei Kompilierung / Keine Zuweisung an Datenfeld möglich.
@Tino : kannst du bitte nochmal helfen ? Meine Daten stehen in Spalte A,B,C,D ab Zeile 2 (wegen Überschrift in Zeile 1) in Tabelle1.
Der Code von UweD funktioniert. Aber etwas überrascht war ich, das die ursprüngliche Zusammenfassung überschrieben und durch den Zahlungsstrom ersetzt wird. Hier muss ich mal schauen, ob ich es schaffe, den Code dahingehend zu ändern, dass er mir den Zahlungsstrom unter die Zusammenfassung stellt.
Liebe Grüße
Mexsalem

Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 21:53:28
Tino
Hallo,
auf die Version habe ich nicht geachtet, kannst mal so versuchen.
Sub ListeGross()
Dim ArrData, ArrAus()
Dim n&, nn&, intDif%
Dim DateAnfang As Date, DateEnde As Date
Dim curRate As Currency

With Tabelle1 'Tabelle anpassen 
    ArrData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
End With
Redim Preserve ArrAus(1 To 3, 1 To 1)
For n = 1 To Ubound(ArrData)
    DateAnfang = ArrData(n, 1)
    DateEnde = ArrData(n, 2)
    curRate = ArrData(n, 3)
    intDif = DateDiff("m", DateAnfang, DateEnde) + 1
    Redim Preserve ArrAus(1 To 3, 1 To Ubound(ArrAus, 2) + intDif)
    Do While DateAnfang < DateEnde
        nn = nn + 1
        ArrAus(1, nn) = DateAnfang
        ArrAus(2, nn) = DateSerial(Year(DateAnfang), Month(DateAnfang) + 1, 0)
        ArrAus(3, nn) = curRate
        DateAnfang = DateSerial(Year(DateAnfang), Month(DateAnfang) + 1, 1)
    Loop
Next n
Call ArrayTranspose(ArrAus)

'Ausgabe ***************************** 
With Tabelle1 'Tabelle anpassen 
    'Überschrift 
    With .Range("E1").Resize(, 3)
        .Cells(1, 1) = "von"
        .Cells(1, 2) = "bis"
        .Cells(1, 3) = "Rate"
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    'Daten 
    With .Range("E2").Resize(nn, 3)
        .Columns(1).Resize(, 2).NumberFormat = "dd.mm.yyyy"
        .Columns(3).NumberFormat = "#,##0.00"
        .Value = ArrAus
        .EntireColumn.AutoFit
    End With
End With
End Sub

Sub ArrayTranspose(varArray())
Dim NewArr(), n&, nn&
Redim Preserve NewArr(1 To Ubound(varArray, 2), 1 To Ubound(varArray))
For n = 1 To Ubound(varArray, 2)
    For nn = 1 To Ubound(varArray)
        NewArr(n, nn) = varArray(nn, n)
    Next nn
Next n
varArray = NewArr
End Sub
Gruß Tino

Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 22:04:52
Mexsalem
Hallo Tino,
danke für die schnelle Antwort, aber die Änderung von 
With Tabelle1 'Tabelle anpassen
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
ArrData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
End With
End With

auf 
With Tabelle1 'Tabelle anpassen
ArrData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
End With
brachte mir wieder diese Fehlermeldung : 
Fehler bei Kompilierung / Keine Zuweisung an Datenfeld möglich.
Gruss
Mexsalem

Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 22:12:41
Tino
Hallo,
habe keine 97er Version mehr, ist auch recht lange her wo ich diese verwendet habe.
Versuche es mal mit dieser.
Sub ListeGross()
Dim ArrData(), ArrAus()
Dim n&, nn&, intDif%
Dim DateAnfang As Date, DateEnde As Date
Dim curRate As Currency

With Tabelle1 'Tabelle anpassen 
    With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
        ArrData = .Value
        DateAnfang = Application.WorksheetFunction.Min(.Columns(1).Resize(, 2))
        DateEnde = Application.WorksheetFunction.Max(.Columns(1).Resize(, 2))
    End With
End With

Redim Preserve ArrAus(1 To DateDiff("m", DateAnfang, DateEnde) + 1, 1 To 3)
For n = 1 To Ubound(ArrData)
    DateAnfang = ArrData(n, 1)
    DateEnde = ArrData(n, 2)
    curRate = ArrData(n, 3)
    intDif = DateDiff("m", DateAnfang, DateEnde) + 1
    Do While DateAnfang < DateEnde
        nn = nn + 1
        ArrAus(nn, 1) = DateAnfang
        ArrAus(nn, 2) = DateSerial(Year(DateAnfang), Month(DateAnfang) + 1, 0)
        ArrAus(nn, 3) = curRate
        DateAnfang = DateSerial(Year(DateAnfang), Month(DateAnfang) + 1, 1)
    Loop
Next n

'Ausgabe ***************************** 
With Tabelle1 'Tabelle anpassen 
    'Überschrift 
    With .Range("E1").Resize(, 3)
        .Cells(1, 1) = "von"
        .Cells(1, 2) = "bis"
        .Cells(1, 3) = "Rate"
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    'Daten 
    With .Range("E2").Resize(nn, 3)
        .Columns(1).Resize(, 2).NumberFormat = "dd.mm.yyyy"
        .Columns(3).NumberFormat = "#,##0.00"
        .Value = ArrAus
        .EntireColumn.AutoFit
    End With
End With
End Sub
Gruß Tino

Anzeige
AW: Monatsdaten wieder auseinander nehmen
02.11.2012 22:20:12
Mexsalem
Hallo Tino,
leider immer noch dieselbe Fehlermeldung, diesmal bei 
ArrData = .Value
Gruss
Mexsalem

AW: Monatsdaten wieder auseinander nehmen
02.11.2012 22:31:15
Tino
Hallo,
habe noch mal was umgebaut, evtl. gehts ja so.
Lade auch mal meine Beispieldatei hoch, vielleicht habe wir nur andere Ausgangsdaten.
https://www.herber.de/bbs/user/82457.xls
Gruß Tino

AW: Monatsdaten wieder auseinander nehmen
02.11.2012 22:41:11
Mexsalem
Hallo Tino,
habe leider noch keinen Erfolg mit deiner Beispielmappe. Funktioniert bei dir sicher, bei mir jedoch kommt wieder diesselbe Fehlermeldung.
Hier ist meine Beispielmappe mit deinem letzten Makro. Es sind keine weiteren Mappen geöffnet, die stören könnten.
https://www.herber.de/bbs/user/82458.xls
Gruss
Mexsalem

Anzeige
kann nicht helfen...
02.11.2012 22:54:18
Tino
Hallo,
bei mir läuft es wie gewollt, Ergebnis sollte wie unten gezeigt aussehen.
Vielleicht kann mal einer drüber schauen der Version 97 noch auf seinem Rechner hat.
 ABCDEFG
1vonbis Rate  vonbisRate
201.12.1231.12.12      100,00    01.12.201231.12.2012100,00
301.01.1330.04.13      200,00    01.01.201331.01.2013200,00
401.05.1330.09.13      500,00    01.02.201328.02.2013200,00
501.10.1328.02.14   5.000,00    01.03.201331.03.2013200,00
601.03.1431.10.14   2.500,00    01.04.201330.04.2013200,00
7    01.05.201331.05.2013500,00
8    01.06.201330.06.2013500,00
9    01.07.201331.07.2013500,00
10    01.08.201331.08.2013500,00
11    01.09.201330.09.2013500,00
12    01.10.201331.10.20135.000,00
13    01.11.201330.11.20135.000,00
14    01.12.201331.12.20135.000,00
15    01.01.201431.01.20145.000,00
16    01.02.201428.02.20145.000,00
17    01.03.201431.03.20142.500,00
18    01.04.201430.04.20142.500,00
19    01.05.201431.05.20142.500,00
20    01.06.201430.06.20142.500,00
21    01.07.201431.07.20142.500,00
22    01.08.201431.08.20142.500,00
23    01.09.201430.09.20142.500,00
24    01.10.201431.10.20142.500,00
25       

Gruß Tino

Anzeige
AW: kann nicht helfen...
02.11.2012 23:10:00
Mexsalem
Hallo Tino,
danke für all deine Bemühungen, vielleicht kann jemand anderes aus dem Forum noch helfen.
Gute Nacht
Mexsalem

AW: kann nicht helfen...
02.11.2012 23:10:16
Mexsalem
Hallo Tino,
danke für all deine Bemühungen, vielleicht kann jemand anderes aus dem Forum noch helfen.
Gute Nacht
Mexsalem

AW: ein letzter Versuch...
04.11.2012 07:45:42
Mexsalem
Moin Tino,
Danke für deinen erneuten Versuch, aber die Fehlermeldung "Keine Zuweisung an Datenfeld" ist hartnäckig :-). Sie wird in der Zeile 
ArrData = DatenTabelle.Range("A2", DatenTabelle.Cells(RowMax, 3))
ausgelöst. Da der Code von UweD funktioniert hat, werde ich versuchen, mir diesen an meine Arbeitsmappe anzupassen.
Gruß
Mexsalem
Anzeige

305 Forumthreads zu ähnlichen Themen

datenimport aus excel in excel
caot

Hi mal wieder!
ich hab mal wieder ne frage:
es sind ca 1200 Excel Dateien aus denen jeweils aus ein paar Zeilen und Spalten die Werte in eine Exceldatei eingelesn werden sollen.
Die Ursprungsdateien sind laufend nummeriert... und dann
kommt noch ein name als nummer- name.xls <...
09.08.2008 11:22:00
Thread-ID: 1000469
3 Beiträge
Anzeige
daten aus Arbeitsmappe einlesen
Peter

Hallo,
kurze Fragestellung an die Experten. Habe mir einen Code zusammengebastelt, der in einer geöffneten Arbeitsmappe, bestimmte Daten aus einer anderen noch "unbestimmten" Arbeitsmappe importieren soll. Funktioniert auch, jedoch kommt mir der Code zu unübersichtlich und auch "unsauber" v...
19.08.2008 13:25:00
Thread-ID: 1002916
3 Beiträge
Daten aus einer Zelle auf mehrere Zellen aufteilen
Gordon

Moin,
ich habe hier einer Zelle (A10) eine bis mehrere Zeichenketten, die jewiels durch ein ";" getrennt werden.
Nun soll jeweils jede Zeichenkette auf drei Zellen aufgespilltet werden:
A1 = Die ersten 10 Zeichen der 1.Kette
B1 = Die nächsten 10 Zeichen der 1.Kette
C1 = Die...
23.08.2008 22:57:00
Thread-ID: 1004183
15 Beiträge
Anzeige
Datenvergleich und danach ausgegebene Info
Merle

Guten morgen alle zusammen!
Hab mal wieder eine Frage. Kriege ständig irgendwelche Listen, die ich zusammenfassen soll.
Hier ein Beispiel meiner Liste:
https://www.herber.de/bbs/user/55376.xls
Ich hätte es gerne, dass wenn ich in der Liste in Tabelle1, nur die Bez. D127 aus dem...
15.09.2008 08:58:00
Thread-ID: 1009662
2 Beiträge
Daten aus Userfom in eine ausgeblendete Tabelle
Ramon

Hallo alle zusammen,
ich möchte nach Klick auf den Command_Button "cb_send" Eingabewerte aus einer
Userform in eine Tabelle schreiben.
In Abhängigkeit der eingegebenen Werte sollen die Daten entweder in das Tabllenblatt
"data_booked" oder in "data_planned" geschrieben werden, u...
16.09.2008 12:28:00
Thread-ID: 1010054
5 Beiträge
Daten aus Zellbereich in eine neue Arbeitsmappe
André

Für eine "Tägliche Auswertung" suche ich ein Makro.
Meine erste Idee war es, hier im Forum zu suchen, ob es da nicht schon was gibt. Leider erfolglos. Ich hab zwar Makros gefunden, die ein neues Wks erstellen mit genau den Vorgaben, die ich brauche und ein Makro zum Zellenbereich kopieren,...
26.09.2008 10:23:00
Thread-ID: 1012532
3 Beiträge
Daten aus Tabelle in eine andere Tabelle
Cornelia

Ich habe 2 Tabellen mit dem gleichen Aufbau.
Tabelle 1 soll die Daten eingetragen werden. Von mehreren Leuten. Deshalb eben seperat.
Tabelle 2 soll die Daten aus Tabelle 1 übernehmen. Jeweils ein Blatt mit identischen Blattnamen aus Tabelle 1. Bisherige Lösung von mir in jede Zelle rein...
01.10.2008 08:11:00
Thread-ID: 1013510
6 Beiträge
Daten aus Inputbox in Zellen untereinander lesen
Peter

Hallo
Bin neu hier, und auch ein Anfänger in VBA, habe folgendes Problem.
Ich möchte, das Datum über eine InputBox in die Zellen untereinander schreiben lassen, also wenn ich am Freitag was Schreibe soll das Datum in A1 stehen, beim nächsten Aufruf der InputBox, soll das Datum in A2 ges...
09.10.2008 20:00:59
Thread-ID: 1015445
3 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
2
1
2
14
3
1
4
2
5
2
5
6
4
4
2
1
1
6
1
4
4
1
1
8
2