Hey Leute,
ich habe da ein Problem. Ich möchte mittels VBA (ich bin dort Anfänger) ein Programm schreiben, dass wenn in der Spalte A ein "falsches Datum" steht, die komplette Zeile gelöscht wird. Das Datum ist chronologisch geordnet und sollte im Regelfall immer eine Minute größer sein als in der Spalte zuvor. Das somit Lücken in der neuen Datumsabfolge entstehen ist richtig.
Anschließend sollte, wenn es mehrere Tage in der Tabelle gibt, jeder Tag in einer separaten Excel Tabelle gespeichert werden. Als Speicher Ort, soll ein angelegter Ordner auf dem Desktop dienen. Der Name der neuen Excel Tabelle entspricht dem Datum.
Bei dem Programm, was ich versucht habe zu schreiben, Funktioniert die Minutenüberprüfung nicht so recht. Mir werden "richtige Datums" auch gelöscht. Und das mit dem Excel tabellenanlegen funktioniert nicht wie geplant.
Es wäre sehr nett, wenn mir dabei jemand helfen kann,
Grüße Anna
'Jede Zeile, die in Spalte A nicht expliziet ein Datum enthält, Inhalt löschen
'Überprüfung des Bezugsdatum
Sub a()
Dim Antwort
Antwort = MsgBox("Ist das Datum in A2 korrekt?", 4, "Frage")
While Antwort = vbNo
Rows(2).Delete Shift:=xlUp
Antwort = MsgBox("Ist nun das Datum in A2 korrekt?", 4, "Frage")
Wend
End Sub
'Jede Spalte muss genau eine Minute größer sein als basis+ (Spaltenanzahl*Minute)sonst Inhalt löschen
Sub aa()
Dim i As Long 'Zellennummer
Dim z As Long 'Anzahl der Zellen
z = Cells(Rows.Count, 1).End(xlUp).Rows.Row
With ActiveSheet
For i = 2 To z Step 1
If .Cells(i, 1) <> (Cells(2, 1) + ((i - 2) / 1440)) Then Cells(i, 1).Clear
Next
End With
End Sub
'Alle Kästchen ohne Inhalt --> Zeile löschen & rest nach oben
Sub aaa()
Dim i As Long
Dim z As Long
z = Cells(Rows.Count, 1).End(xlUp).Rows.Row
With ActiveSheet
For i = 2 To z Step 1
If .Cells(i, 1) = "" Then .Rows(i).Delete Shift:=xlUp
Next
End With
End Sub
'Einzelne Exeltabellen für jeweils einen Tag(0-23,59Uhr)Namens:JJJJMMTT.xls
Sub aaaa()
Dim i As Long
Dim z As Long
Dim wbDir As String
Dim x As Range
Dim d As Date
x = Range("A2")
d = CDate(x)
z = Cells(Rows.Count, 1).End(xlUp).Rows.Row
MkDir ("C:\Users\Desktop\Test") ' Verzeichnis erstellen, in dem die Dateien erstellt werden (entsprechend anpassen)
With ActiveSheet
wbDir = "C:\Users\Desktop\Test\" ' Verzeichnis, in dem die Dateien erstellt werden (entsprechend anpassen)
For i = 2 To z Step 1
If .Cells(i, 1) = CDate(x) Then .SaveAs Format(CDate(x), "yyyymmdd") & ".xls"
Next
End With
MsgBox "Dateien erstellt!"
End Sub
|