Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
924to928
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
924to928
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code anpassen

Code anpassen
15.11.2007 20:46:32
Fritz_W
Hallo VBA-Experten,
in der Tabelle1 steht in der Spalte B ab Zeile 2 jeweils der Anfangstermin, in der Spalte C der jeweiligen Zeile der Endtermin eines Zeitraumes.
Mit dem nachstehenden Code wird aufgrund der Eintragungen in der Tabelle1 in der Tabelle2 in Spalte B eine chronologische Liste erstellt.
Ich würde nun den Code dahingehend geändert haben, dass diese Liste nicht in Tabelle2 sondern ebenfalls in der Tabelle1 (Spalte E beginnend ab Zeile 2) erstellt wird. Zusätzlich sollte der Eintrag aus Spalte D der Tabelle1 in die Spalte F übernommen werden und zwar für jeden Tag des entsprechenden Zeitraums.
Vielen Dank für eure Unterstützung.
mfg
Fritz

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code anpassen
15.11.2007 20:48:06
Fritz_W
Hallo,
habe in der Hektik vergessen, den bisherigen Code beizufügen:

Public Sub Tage_auflisten()
Dim WkSh_Q    As Worksheet
Dim WkSh_Z    As Worksheet
Dim lZeile_Q  As Long
Dim lZeile_Z  As Long
Dim dDatum    As Date
Application.ScreenUpdating = False
Set WkSh_Q = Worksheets("Tabelle1")
Set WkSh_Z = Worksheets("Tabelle2")
lZeile_Z = 2
For lZeile_Q = 2 To WkSh_Q.Range("A65536").End(xlUp).Row
If IsDate(WkSh_Q.Range("B" & lZeile_Q).Value) And _
IsDate(WkSh_Q.Range("C" & lZeile_Q).Value) Then
dDatum = CDate(WkSh_Q.Range("B" & lZeile_Q).Value)
Do
WkSh_Z.Range("B" & lZeile_Z).NumberFormat = "ddd dd/mm/yyyy"
WkSh_Z.Range("B" & lZeile_Z).Value = dDatum
lZeile_Z = lZeile_Z + 1
dDatum = dDatum + 1
Loop Until dDatum > CDate(WkSh_Q.Range("C" & lZeile_Q).Value)
End If
Next lZeile_Q
Application.ScreenUpdating = True
End Sub


Gruß
Fritz

Anzeige
AW: Code anpassen
15.11.2007 21:21:00
Jan3
Hi,
Teste mal folgenden Code.
  • 
Public Sub Tage_auflisten_2()
Dim ws    As Worksheet
Dim z1  As Long
Dim lZeile_Z  As Long
Dim dDatum    As Date
Application.ScreenUpdating = False
Set ws = Worksheets("Tabelle1")
lz = 2
anz = ws.Range("A65536").End(xlUp).Row
For z1 = 2 To anz
If IsDate(ws.Range("B" & z1)) And IsDate(ws.Range("C" & z1)) Then
dDatum = CDate(ws.Range("B" & z1))
wert = ws.Cells(z1, 4)
Do
ws.Range("E" & lz).NumberFormat = "ddd dd/mm/yyyy"
ws.Range("E" & lz) = dDatum
ws.Cells(lz, 6) = wert
lz = lz + 1
dDatum = dDatum + 1
Loop Until dDatum > CDate(ws.Range("C" & z1).Value)
End If
Next
Application.ScreenUpdating = True
End Sub



    • Jan

    Anzeige
    AW: Code anpassen
    15.11.2007 21:45:43
    Fritz_W
    Hallo Jan,
    funktioniert super, vielen Dank!!
    mfg
    Fritz

    AW: Code anpassen
    15.11.2007 20:48:00
    Fritz_W
    Hallo,
    habe in der Hektik vergessen, den bisherigen Code beizufügen:
    
Public Sub Tage_auflisten()
Dim WkSh_Q    As Worksheet
Dim WkSh_Z    As Worksheet
Dim lZeile_Q  As Long
Dim lZeile_Z  As Long
Dim dDatum    As Date
Application.ScreenUpdating = False
Set WkSh_Q = Worksheets("Tabelle1")
Set WkSh_Z = Worksheets("Tabelle2")
lZeile_Z = 2
For lZeile_Q = 2 To WkSh_Q.Range("A65536").End(xlUp).Row
If IsDate(WkSh_Q.Range("B" & lZeile_Q).Value) And _
IsDate(WkSh_Q.Range("C" & lZeile_Q).Value) Then
dDatum = CDate(WkSh_Q.Range("B" & lZeile_Q).Value)
Do
WkSh_Z.Range("B" & lZeile_Z).NumberFormat = "ddd dd/mm/yyyy"
WkSh_Z.Range("B" & lZeile_Z).Value = dDatum
lZeile_Z = lZeile_Z + 1
dDatum = dDatum + 1
Loop Until dDatum > CDate(WkSh_Q.Range("C" & lZeile_Q).Value)
End If
Next lZeile_Q
Application.ScreenUpdating = True
End Sub


    Gruß
    Fritz

    Anzeige

    Beliebteste Forumthreads (12 Monate)

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

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige