Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
780to784
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
780to784
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBa um Daten zu kopieren

VBa um Daten zu kopieren
13.07.2006 18:16:12
Tom
Hallo Zusammen,
ich habe heute wieder mal ein kleines Problem und bitte um Hilfe. Für die VBA Freaks ist dies sicherlich eine Kleinigkeit.
Ich habe Darlehensdaten und möchte daraus einen Gesamt-Cash flow erzeugen.
Denn Generator habe ich schon selbst gebastelt, mir gelingt es aber nicht die Daten zu eine Zahlungsreihe zu aggregieren.
Jeweils die Grunddaten aus dem Sheet (erster Datensatz B3:H3) Grunddaten sollen in das Sheet Rechner (B2:B8) kopiert werden. Dann sollen ab F13 alles Werte kopiert werden wo ein Datum enthalten ist. (kopiert sollen dann der Datumswert und der dazugehörige Cash-flow werden.)Diese kopierten Daten sollen dann in dem Sheet Gesamt CF eingefügt werden (ab A1 nach unten). Dann soll der nächste Datensatz aus Sheet Grunddaten in der vorher beschriebenen Weise übertragen wedren um auch hier den Cash-flow zu erhalten. Der Neue Cash-flow soll unter dem alten in Blatt Gesamt CF eingefügt werden. Dies soll dann so lange erfolgen, bis alle Datensätze in Sheet Grunddaten abgearbeitet sind. Zu guter letzt sollen dann noch alle Daten im Sheet Gesamt CF nach dem Datum aufsteigend sortiert werden.
Für Eure Hilfe bedanke ich mich schon jetzt im voraus und freue mich umgehend
eine HIlfe zu bekommen.
https://www.herber.de/bbs/user/35061.xls
Ciao Tom

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBa um Daten zu kopieren
14.07.2006 10:46:23
Tom
Hallo Harald,
danke für Deine Hilfe. Könntest Du mir den Code auch im Forum sichtbar einstellen, da ich in der Firma keine Dateien mit Makro herunterladen kann. Immer diese Firewall. Danke ich hoffe Du kannst dies realisieren!
Schonmal ein großes Dankeschön
Tom
AW: VBa um Daten zu kopieren
14.07.2006 11:02:06
Harald
Hi,
Null problemo. Dieser Code gehört ins Standardmodul.
Sub GrunddatenNachCF()
Dim LrowA As Long, LrowB As Long, LrowC As Long, i As Long, x As Long
Dim grd As Object, rch As Object, gcf As Object
'Bildschirmflackern ausschalten
Application.ScreenUpdating = False
Set grd = Sheets("Grunddaten")
Set rch = Sheets("Rechner")
Set gcf = Sheets("Gesamt CF")
'letzte gefüllte Zelle in Grunddaten, Spalte A
LrowA = grd.Cells(Rows.Count, 1).End(xlUp).Row
'kleiner 3, dann Abbruch
If LrowA ' erste Schleife für alle Daten in Grunddaten
For i = 3 To LrowA
'Werte transponiert nach Rechner"
grd.Range("B" & i & ":H" & i).Copy
rch.Range("B2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
'letzte gefüllte Zelle in Rechner, Spalte F
LrowB = rch.Cells(Rows.Count, 6).End(xlUp).Row
'zweite Schleife, wenn Datum in F, dann...
For x = 13 To LrowB
If IsDate(rch.Range("F" & x)) Then
'erste freie Zelle in Gesamt CF, Spalte A
LrowC = gcf.Cells(Rows.Count, 1).End(xlUp).Row + 1
gcf.Range("A1") = "Datum"
gcf.Range("B1") = "CF"
'Werteübertrag rechner an Gesamt CF
gcf.Range("A" & LrowC & ":B" & LrowC) = rch.Range("F" & x & ":G" & x).Value
End If
Next x
Next i
'Spaltengröße anpassen
gcf.Columns.AutoFit
'Spalte B Werte als Euro
gcf.Range("B2:B" & LrowC).NumberFormat = "#,##0.00 $"
'genutzten Bereich nach Datum sortieren
gcf.Range("A2").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub
ggf. noch diesen Code als Starter mit Abfrage durch Button im Blatt "Grunddaten"

Private Sub CommandButton1_Click()
If MsgBox("Datenübertragung starten ?", vbYesNoCancel, "Abfrage") = vbYes Then
Call GrunddatenNachCF
Else
Range("A1").Select
End If
End Sub

Gruss Harald
Anzeige
AW: VBa um Daten zu kopieren
14.07.2006 11:32:37
Tom
Hallo Harald,
danke für Deine tolle Hilfe es funktioniert alles nach Wunsch. Ich weiß gar nicht warum Du den Code als nicht so schön empfunden hast, er erfüllt doch seine Zweck optimal.
Vielleicht hast Du aber auch noch eine Idee zur Erweiterung. Wenn ich in der Grunddatei sehr viele Datensätze habe, dann wird mein Cash flow dementsprechend lang. D.h. die Zeilenanzahl (65536) könnte nicht ausreichen. Daher meine Frage, wir könnte der Code verändert werden, das bei nicht mehr ausreichender Zeilenanzahl die Werte dann im Gesamt-Cash-flow Blatt ab Feld C2 weiter geschrieben werden. Wenn dies auch nicht ausreicht dann in Feld E2 gehen u.s.w.
Wenn DU dies noch lösen könntest wäre mein Tool perfekt.
Viele Grüße und voller Erwartung auf die Lösung
Tom
Anzeige
AW: VBa um Daten zu kopieren
14.07.2006 12:56:47
Harald
Hi,
bitteschön. Und mit "nicht so schön" meinte ich den Umstand, dass von mir als vba-Amateur eben nur vba-Hausmannskost kommt. Die Spezies brauchen ein Drittel weniger Code und haben obendrein noch Fehlerhandling drin.

Sub GrunddatenNachCF()
Dim LrowA As Long, LrowB As Long, LrowC As Long, i As Long, x As Long
Dim grd As Object, rch As Object, gcf As Object
Dim Fcol As Integer, addwert As Integer
Dim durchlauf As Boolean
'Bildschirmflackern ausschalten
Application.ScreenUpdating = False
durchlauf = True
Set grd = Sheets("Grunddaten")
Set rch = Sheets("Rechner")
Set gcf = Sheets("Gesamt CF")
'letzte gefüllte Zelle in Grunddaten, Spalte A
LrowA = grd.Cells(Rows.Count, 1).End(xlUp).Row
'kleiner 3, dann Abbruch
If LrowA < 3 Then Exit Sub
' erste Schleife für alle Daten in Grunddaten
For i = 3 To LrowA
'Werte transponiert nach Rechner"
grd.Range("B" & i & ":H" & i).Copy
rch.Range("B2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
'letzte gefüllte Zelle in Rechner, Spalte F
LrowB = rch.Cells(Rows.Count, 6).End(xlUp).Row
addwert = LrowB - 13
If durchlauf = True Then
Fcol = gcf.Cells(2, Columns.Count).End(xlToLeft).Column
If Fcol = 1 Then Fcol = 2
If gcf.Cells(Rows.Count, Fcol).End(xlUp).Row + addwert > 65500 Then
Fcol = Fcol + 2
End If
End If
durchlauf = False
'zweite Schleife, wenn Datum in F, dann...
For x = 13 To LrowB
If IsDate(rch.Range("F" & x)) Then
'erste freie Zelle in Gesamt CF, Spalte A
LrowC = gcf.Cells(Rows.Count, Fcol - 1).End(xlUp).Row + 1
gcf.Cells(1, Fcol - 1) = "Datum"
gcf.Cells(1, Fcol) = "CF"
'Werteübertrag rechner an Gesamt CF
gcf.Range(Cells(LrowC, Fcol - 1), Cells(LrowC, Fcol)) = rch.Range("F" & x & ":G" & x).Value
End If
Next x
Next i
'Spaltengröße anpassen
gcf.Columns.AutoFit
'zweite Spalte Werte als Euro
gcf.Range(Cells(2, Fcol), Cells(LrowC, Fcol)).NumberFormat = "#,##0.00 $"
'genutzten Bereich nach Datum sortieren
gcf.Range(Cells(2, Fcol - 1), Cells(LrowC, Fcol)).Sort Key1:=Cells(2, Fcol - 1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
'Call farbkennung
End Sub



Sub farbkennung()
Dim i As Integer, Lcol As Integer
'jeder zweite Überschriftenblock hellgrau
Lcol = Sheets("Gesamt CF").Cells(2, Columns.Count).End(xlToLeft).Column
For i = 1 To Lcol Step 4
Range(Cells(1, i), Cells(1, i + 1)).Interior.ColorIndex = 15
Next
End Sub

Gruss Harald
Anzeige
AW: VBa um Daten zu kopieren
14.07.2006 14:54:18
Tom
Hallo Harald,
vielen Dank für Deine Unterstützung klappt alles super!!
Vielleicht bis bald mal wieder!!
Gruß Tom
Danke für die Rückmeldung owT
14.07.2006 14:55:53
Harald
Gruss Harald

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige