Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
528to532
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
528to532
528to532
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

abspeichern datumsbezogen

abspeichern datumsbezogen
10.12.2004 22:56:03
mayk
über diesen macro speichere ich daten in eine 2. tabelle von tab.1 c5:c32 nach tab2 c5:c32
nun möchte ich in tabelle1 die Zellen c5:c32 einem aktuellen Datum (funktion datum heute )c4 zuordnen. die eingabe soll in tab 1 immer auf c5:c32 bleiben (mit aktuellem datum auf c4) beim speichern aber würden sich die daten dann immer in tab. 2 auf c5:c32 überschreiben, wenn ich heute 10.12.speichere dann auf c5:c32 morgen 11.12. dann auf d5:d32 und das 365 tage?
funktioniert soetwas wenn ja wie?
Application.ScreenUpdating = False
Range("C5:C32").Copy
Workbooks.Open Filename:= _
"P:\mayk\Übersicht Paletten\datenblatt.xls"
ActiveSheet.[c5].PasteSpecial Paste:=xlAll, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False
Range("C5:C32").ClearContents

Application.ScreenUpdating = True

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: abspeichern datumsbezogen
10.12.2004 23:21:19
Torben
Hi mayk,
bastel Dir das Makro einfach so um wie Du Ihn brauchst, hoffe das hilft Dir irgendwie hatte ein ähnliches Problem
mfG
Torben


Sub Datum()
Range("G13").Select
ActiveCell.Value = Date
Range("G14").Select
End Sub

AW: abspeichern datumsbezogen
10.12.2004 23:30:14
mayk
hallo torben
nein nicht wirklich ich wüßte nicht wie ich das mit meinem macro zusammenschreiben sollte
gruß mayk
AW: abspeichern datumsbezogen
10.12.2004 23:40:44
Torben
sorry... Du willst das Datum in den Dateinamen packen...ok ok...
bau Dir das hier um..

Sub Speichern()
' Tastenkombination: Strg+y
'Dialogfeld "Speichern unter" aufrufen
'und dabei den Dateipfad und den Dateinamen 'vorgeben Dim strDateiname As String Dim strAntwort As String
'Dateiname = Werte aus D20 und G20
strDateiname = Cells(20, 4).Value & "_" & Cells(20, 7).Value & ".xls"
Dim strDate As String
strDate = Date
Dim strClock As String
strClock = Time
Dim Pfad As String
strPfad = "C:\Firmendaten\Arbeitszettel\" & strDate
ChDrive "C:\"
ChDir "\Firmendaten\Arbeitszettel\" & strDate
ActiveWorkbook.SaveAs (strDateiname)
MsgBox ("Datei unter " & strPfad & "\" & strDateiname & " gespeichert!")
Workbooks.Open Filename:="C:\Firmendaten\Arbeitszettel\Dateiliste.xls"
[A1].Activate
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
Size = 30
Loop
ActiveCell = strDateiname
[B1].Activate
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
Size = 20
Loop
ActiveCell = strDate
[C1].Activate
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
Size = 15
Loop
ActiveCell = strClock
[D1].Activate
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
Size = 15
Loop
ActiveCell = strPfad & "\" & strDateiname
[E1].Activate
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
Size = 15
Loop
ActiveCell = strPfad
ActiveCell.Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strPfad & "\" & strDateiname
Workbooks("Dateiliste.xls").CreateBackup
Workbooks("Dateiliste.xls").Save
Workbooks("Dateiliste.xls").Close
MsgBox ("Position " & strDateiname & " in Dateiliste abgelegt!")
End Sub

Anzeige
AW: abspeichern datumsbezogen
10.12.2004 23:57:06
PeterW
Hallo Mayk,
da ein Excel-Arbeitsblatt nur 256 Spalten hast kannst du keine 365 Datensätze in Spalten unterbringen. Da mir unklar ist, wie das Datum angesprochen wird wäre eine Beispielmappe auf dem Server hilfreich. Packe das Zielblatt in die Mappe mit den Quelldaten (Öffnen und Speichern einer Mappe hast du ja schon gelöst).
Gruß
Peter
AW: abspeichern datumsbezogen
11.12.2004 00:33:29
mayk
mmh stimmt, aber evtl. nur Arbeitstage 52 Wochen *5Tage=260,vieleicht über mehrere tabellen
gruß mayk

Die Datei https://www.herber.de/bbs/user/14664.xls wurde aus Datenschutzgründen gelöscht

AW: abspeichern datumsbezogen
11.12.2004 00:51:28
PeterW
Hallo Mayk,
bei 256 ist was die Spalten angeht Feierabend.;-)
Schau dir mal das an und wundere dich nicht über den auskommentierten Code.
https://www.herber.de/bbs/user/14666.xls
Gruß
Peter
Anzeige
AW: abspeichern datumsbezogen
11.12.2004 15:38:47
mayk
hallo peter
ok was die tabellenform angeht gut so gehts evtl. auch nur das speicher muß für den jeweiligen tag immer wieder neu aufaddiert werden erst mit dem nächsten tag darf eine neue zeile beschrieben werden.
gruß mayk
AW: abspeichern datumsbezogen
11.12.2004 16:00:52
PeterW
Hallo Mayk,
dann ändere den Code wie folgt:

Sub DatenKopieren()
Dim lgZiel As Long
lgZiel = Sheets("Speicherort").Range("A65536").End(xlUp).Row
If Cells(lgZiel, 1) <> Date Then lgZiel = lgZiel + 1
Range("C4:C32").Copy
Sheets("Speicherort").Cells(lgZiel, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=True
Sheets("speicherort").Cells(lgZiel, 1).NumberFormat = "DD.MM.YYYY"
Range("C5:C32").ClearContents
End Sub

Gruß
Peter
Anzeige
Korrektur
11.12.2004 16:10:00
PeterW
Hallo Mayk,
sorry, hat sich ein Fehler eingeschlichen. Statt
If Cells(lgZiel, 1) <> Date Then lgZiel = lgZiel + 1
muss es heißen
If Sheets("Speicherort").Cells(lgZiel, 1) <> Date Then lgZiel = lgZiel + 1
Gruß
Peter
AW: abspeichern datumsbezogen
11.12.2004 17:28:13
mayk
hallo peter,
fehler beim kompilieren, nach einfügen des codes
gruß mayk
AW: abspeichern datumsbezogen
11.12.2004 17:44:30
PeterW
Hallo Mayk,
hab es jetzt selber nochmal nachgebaut. So läuft es bei mir:

Sub DatenKopieren()
Dim lgZiel As Long
lgZiel = Sheets("Speicherort").Range("A65536").End(xlUp).Row
If Sheets("speicherort").Cells(lgZiel, 1) <> Date Then
lgZiel = lgZiel + 1
Sheets("Speicherort").Cells(lgZiel, 1) = Cells(4, 3)
End If
Range("C5:C32").Copy
Sheets("Speicherort").Cells(lgZiel, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=True
Sheets("Speicherort").Cells(lgZiel, 1).NumberFormat = "DD.MM.YYYY"
Range("C5:C32").ClearContents
End Sub

Gruß
Peter
Anzeige
AW: abspeichern datumsbezogen
11.12.2004 17:44:59
mayk
sorry läuft ich hatte im code einen fehler, jetzt wird aber ohne tabelle gespeichert geht es vieleicht auchnoch mit (gegenwertig werden nur daten gespeichert aber ohne tabelle)
gruß mayk
AW: abspeichern datumsbezogen
11.12.2004 18:02:02
PeterW
Hallo Mayk,
auch das ist möglich, beispielsweise so:

Sub DatenKopieren()
Dim lgZiel As Long
lgZiel = Sheets("Speicherort").Range("A65536").End(xlUp).Row
If Sheets("speicherort").Cells(lgZiel, 1) <> Date Then
lgZiel = lgZiel + 1
Sheets("Speicherort").Cells(lgZiel, 1) = Cells(4, 3)
End If
Range("C5:C32").Copy
Sheets("Speicherort").Cells(lgZiel, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=True
Sheets("Speicherort").Cells(lgZiel, 1).NumberFormat = "DD.MM.YYYY"
With Sheets("Speicherort").UsedRange
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Range("C5:C32").ClearContents
End Sub

Gruß
Peter
Anzeige
AW: abspeichern datumsbezogen
11.12.2004 18:16:31
mayk
hallo peter,
jaa, es funzt aber es sollte nur für eine zeile jeweils sein, und ich merke gerade das beim speichern sich die daten nur einmal addieren und dann eine neue zeile geschrieben wird, ich müßte aber folgendes erreichen der speicerbutton müßte für den ganzen tag für diese eine zeile sein und sich jeweils aufaddieren und mit neuem tag und neuem datum eine neue zeile und da ich wochenbezogen diese daten auswerten muß, müßen nach 5tagen /also 5 zeilen/ ein bis zwei zeilen frei bleiben und dann erst wieder dei nächsten zeilen
AW: abspeichern datumsbezogen
11.12.2004 18:31:43
PeterW
Hallo Mayk,
das kann ich nicht nachvollziehen. Habe gerade 12 mal Werte mit dem Button übertragen und alle wurden, wie gewünscht übertragen uind addiert. Nach Änderung des Systemdatum auf einen anderen Tag wird eine neue Zeile angelegt und auch in dieser lässt sich beliebig oft addieren.
Zum Problem mit den 5 Tagen und der Wochenauswertung: werden wirklich immer 5 Tage mit Werten gefüllt? Was ist mit Feiertagen, Urlaub...? Man könnte die Kalenderwoche des Datums abfragen und mit der des letzten eingetragenen Datums vergleichen. Würde das dein Problem lösen können?
Gruß
Peter
Anzeige
AW: abspeichern datumsbezogen
11.12.2004 18:45:18
mayk
hallo peter
ich weiß nicht was es war, aber nun speichert`s korrekt
wenn dadurch eine 5 tägige einteilung mit ein- oder besser zwei freizeilen erreicht wird ja es bleibt bei 5 tagen, wie ist es bei feiertagen in der woche beim abgleich mit der kw?
gruß mayk
AW: abspeichern datumsbezogen
11.12.2004 19:26:33
PeterW
Hallo Mayk,
wenn es sich immer um 5 Tage handelt (hoffentlich am Montag beginnend) dann sieht der Code so aus:

Sub DatenKopieren()
Dim lgZiel As Long
lgZiel = Sheets("Speicherort").Range("A65536").End(xlUp).Row
If Sheets("speicherort").Cells(lgZiel, 1) <> Date Then
If Weekday(Sheets("Speicherort").Cells(lgZiel, 1), vbMonday) = 1 Then
lgZiel = lgZiel + 3
Else
lgZiel = lgZiel + 1
End If
Sheets("Speicherort").Cells(lgZiel, 1) = Cells(4, 3)
End If
Range("C5:C32").Copy
Sheets("Speicherort").Cells(lgZiel, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=True
Sheets("Speicherort").Cells(lgZiel, 1).NumberFormat = "DD.MM.YYYY"
With Sheets("Speicherort").UsedRange
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Range("C5:C32").ClearContents
End Sub

Je nach Zeitpunkt deiner Zwischenauswertungen musst du allerdings darauf achten, dass die Spalte A in der Wochenauswertung frei bleibt!
Gruß
Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige