Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > Wert aus Vortag übernehmen
Normale Version: Wert aus Vortag übernehmen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2

Coprat

23.08.2019, 12:22
Hallo,

ich benutze folgenden Code um mir einen Monat zu generieren

Code:
Sub MachMirEinenMonat()
Dim wksQuelle As Worksheet
Dim vntDatum As Variant
Dim lngMonat As Long
Dim lngJahr As Long
Dim wbkNeu As Workbook
Dim lngTageImMonat As Long
Dim lngTag As Long
Set wksQuelle = ThisWorkbook.Worksheets("MeinBeispiel")

vntDatum = InputBox("Gib ein beliebiges Datum des gewünschten Monats ein!" & vbCr & "Beispiel: 13.2.2012")

If Not IsDate(vntDatum) Then
MsgBox "Kein Datum!", , vntDatum
Exit Sub
End If

lngMonat = Month(vntDatum)
lngJahr = Year(vntDatum)
lngTageImMonat = Day(DateSerial(lngJahr, lngMonat + 1, 0))
wksQuelle.Copy
Set wbkNeu = ActiveWorkbook

For lngTag = 2 To lngTageImMonat
wbkNeu.Worksheets(1).Copy After:=wbkNeu.Worksheets(wbkNeu.Worksheets.Count)
Next
For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
Next

'lösche alle Sonntage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 1 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

'lösche alle Samstage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 7 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

End Sub
Kann man diesen Code erweitern, so dass in den den Zellen B53:O53 und B62:P62 die Werte aus dem Vortag aus B57:O57 und B66:P66 übernommen werden. Also als Formel z.B.
Code:
='03.09'!B57
diese Formel würde auf Tabellenblatt 04.09 in Zelle B53 stehen.

Am ersten Tag des Monats würde der Wert händich eingetragen werden.


Vielen Dank für eure Gedanken

schauan

23.08.2019, 12:47
Hallöchen,

das Einfügen der Formel könnte z.B. in diesen Bereich:

For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
if lngTag > 1 then Rang("B53:O53").Formule = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag-1), "dd.mm") & "'!B57"
Next

(ungetestet)

Coprat

23.08.2019, 13:04
(23.08.2019, 12:47)schauan schrieb: [ -> ]Hallöchen,

das Einfügen der Formel könnte z.B. in diesen Bereich:

For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
if lngTag > 1 then Range("B53:O53").Formule = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag-1), "dd.mm") & "'!B57"
Next

(ungetestet)

Danke erst mal das mit Range habe ich noch selber rausgefunden aber nach dem umbennen der ersten beiden Tabellenblätter sagt er Objekt unterstützt Eigenschaft oder Methode nicht

Ne Idee?

snb

23.08.2019, 13:16
Zum erstellen der Arbeisblätter reicht schon aus:


Code:
Sub M_snb()
   y = CLng(InputBox("Monatsnummer 1-12", "snb", 1))
   
   For j = 1 To 31
     x = DateSerial(Year(Date), y, j)
     If Weekday(x, 2) < 6 And Month(x) = y Then
        Sheets(1).Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Format(x, "dd.mm")
     End If
   Next
End Sub

schauan

23.08.2019, 13:45
Hallöchen,

meine Tastatur und ich gehen heute wohl getrennte Wege Smile Formule sollte auch Formula sein Smile

Coprat

26.08.2019, 06:53
Hallo Schauaun,

der Code sieht jetzt folgendermaßen aus


Code:
Sub MachMirEinenMonat()
Dim wksQuelle As Worksheet
Dim vntDatum As Variant
Dim lngMonat As Long
Dim lngJahr As Long
Dim wbkNeu As Workbook
Dim lngTageImMonat As Long
Dim lngTag As Long
Set wksQuelle = ThisWorkbook.Worksheets("Tabelle1")

vntDatum = InputBox("Gib ein beliebiges Datum des gewünschten Monats ein!" & vbCr & "Beispiel: 13.2.2012")

If Not IsDate(vntDatum) Then
MsgBox "Kein Datum!", , vntDatum
Exit Sub
End If

lngMonat = Month(vntDatum)
lngJahr = Year(vntDatum)
lngTageImMonat = Day(DateSerial(lngJahr, lngMonat + 1, 0))
wksQuelle.Copy
Set wbkNeu = ActiveWorkbook

For lngTag = 2 To lngTageImMonat
wbkNeu.Worksheets(1).Copy After:=wbkNeu.Worksheets(wbkNeu.Worksheets.Count)
Next
For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
If lngTag > 1 Then Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
Next

'lösche alle Sonntage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 1 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

'lösche alle Samstage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 7 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

End Sub
Leider stehen trotzdem keine Formeln drin. Die Tag werden erstellt wie vorher nur die Formeln sind nicht in den Zellen und der Ertste Tag wird nicht mehr erstellt.

Hast du eine Idee?

snb

26.08.2019, 08:50
Code:
Sub M_snb()
   y = CLng(InputBox("Monatsnummer 1-12", "snb", 1))
   
   For j = 1 To 31
     x = DateSerial(Year(Date), y, j)
     If Weekday(x, 2) < 6 And Month(x) = y Then
        Sheets(1).Copy , Sheets(Sheets.Count)
        with Sheets(Sheets.Count)
           .Name = Format(x, "dd.mm")
           .cells.replace("*!"),.name & "!",2
        end with
     End If
   Next
End Sub

Coprat

26.08.2019, 11:33
Hallo SNB,

auch hier das Problem, dass der erste Tag nicht angelegt wird und die Formeln nicht eingetragen wird. Wo steht denn in welche Zellen die Formel eingetragen wird?


LG Sven
Mit dem ersten Tag nicht angelgt könnt Ihr vergessen ist ja klar wenn der ewrste Tag nen Samstag bzw Sonntag ist Liegt es dann daran, dass die Formeln nicht eingegeben werden?
Code:
'hier formel einfuegen
If lngTag > 1 Then Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"
Next

So habe ich das jetzt angepasst um meine Bereiche wo die Formeln hin sollen auch klappt

Excel macht dies aber nur auf dem letzten Tabellenblatt des Monats Warum?

Steffl

26.08.2019, 12:12
Hallo,

IMHO fehlt es da an einer korrekten Referenz.

Code:
If lngTag > 1 Then Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then Worksheets(lngTag).Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"

Coprat

26.08.2019, 12:28
Index außerhalb des gültigen Bereichs


Dodgy Confused

mit meiner erweiterung hat es geklappt halt nur auf dem Letzten reiter. Jetzt Sthen am letzten Tag des Monats in Zellen B53:O53 und in Zellen B62:P62 die werte von dem vorletzten Tag aus B57:O57 bzw B66:P66
Bei Schauaun war es auch nur auf der letzten Seite
Also nochmal der komplette Code wie ich Ihn benutze Ich habe das entfernen von Samstag und Sonntag rausgenommen, dann klappt es auf dem letzten Blatt mit dem einfügen der Formel.

wie bekomme ich es hin, dass auf allen außer dem ersten Blatt des Monats die Formel eingegeben wird?

Code:
Sub MachMirEinenMonat()
Dim wksQuelle As Worksheet
Dim vntDatum As Variant
Dim lngMonat As Long
Dim lngJahr As Long
Dim wbkNeu As Workbook
Dim lngTageImMonat As Long
Dim lngTag As Long
Set wksQuelle = ThisWorkbook.Worksheets("Tabelle1")

vntDatum = InputBox("Gib ein beliebiges Datum des gewünschten Monats ein!" & vbCr & "Beispiel: 13.2.2012")

If Not IsDate(vntDatum) Then
MsgBox "Kein Datum!", , vntDatum
Exit Sub
End If

lngMonat = Month(vntDatum)
lngJahr = Year(vntDatum)
lngTageImMonat = Day(DateSerial(lngJahr, lngMonat + 1, 0))
wksQuelle.Copy
Set wbkNeu = ActiveWorkbook

For lngTag = 2 To lngTageImMonat
wbkNeu.Worksheets(1).Copy After:=wbkNeu.Worksheets(wbkNeu.Worksheets.Count)
Next
For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
If lngTag > 1 Then Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"
Next

End Sub



Danke für eure Überlegungen
Seiten: 1 2
Clever-Excel-Forum > Office-Anwendungen > Excel > Wert aus Vortag übernehmen