|
Ein fröhliches "Moin moin" zusamm',
nach einigem Suchen habe ich ähnliche Problematiken gefunden (leere Zellen füllen), konnte diese aber nicht anwenden.
Ich beziehe mich auf die Vorlage von PCTipp.ch leere Zellen mit obigem Inhalt ausfüllen und Datum und Uhrzeit umwandeln von http://www.hajo-excel.de.
Ausgangssituation:
ExcelTabelle mit 3 Spalten A,B,C
-
In Spalte A werden numerische, fünf- bis achtstellige Eingaben in ein Datum (dmmyy/ ddmmyy nach dd.mm.yy oder dmmyyyy/ ddmmyyyy nach dd.mm.yyyy) umgewandelt (Punkte hinzugefügt)
-
In Spalte B werden numerische, sechs- oder fünfstellige Eingaben in eine Uhrzeit (hmmss/ hhmmss nach hh:mm:ss) umgewandelt (Doppelpunkte hinzugefügt)
-
In Spalte C erfolgt eine numerische Wert X. Unausgefüllte Zellen, also Zellen ohne Werteingabe des Benutzers, sollen den nächsten, obigen Wert der Spalte zugeordnet bekommen. (Beispiel: C1=x1; C2=""; C3=""; C4=x2; C5="" dann soll C2=x1; C3=x1; C5=x2)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich1 As Range
Dim RaZelle1 As Range
Set RaBereich1 = Range("A1:A1006")
Set RaBereich1 = Intersect(RaBereich1, Range(Target.Address))
If Not RaBereich1 Is Nothing Then
Application.EnableEvents = False
For Each RaZelle1 In Range(Target.Address)
With RaZelle1
If (Len(.Value2) = 6 Or Len(.Value2) = 5) _
And IsNumeric(.Value2) Then
If Len(.Value2) = 6 Then
.Value = CDate(Mid(.Value2, 1, 2) _
& "." & Mid(.Value2, 3, 2) & "." _
& Mid(.Value2, 5, 2))
ElseIf Len(.Value2) = 5 Then
.Value = CDate(Mid(.Value2, 1, 1) _
& "." & Mid(.Value2, 2, 2) & "." _
& Mid(.Value2, 4, 2))
End If
.NumberFormat = "dd/mm/yy;@"
Application.EnableEvents = True
ElseIf (Len(.Value2) = 8 Or Len(.Value2) = 7) _
And IsNumeric(.Value2) Then
If Len(.Value2) = 8 Then
.Value = CDate(Mid(.Value2, 1, 2) _
& "." & Mid(.Value2, 3, 2) & "." _
& Mid(.Value2, 5, 4))
ElseIf Len(.Value2) = 7 Then
.Value = CDate(Mid(.Value2, 1, 1) _
& "." & Mid(.Value2, 2, 2) & "." _
& Mid(.Value2, 4, 4))
End If
.NumberFormat = "dd/mm/yyyy;@"
Application.EnableEvents = True
Else
.NumberFormat = "0"
End If
End With
Next RaZelle1
Application.EnableEvents = True
End If
Set RaBereich1 = Nothing
Dim RaBereich2 As Range
Dim RaZelle2 As Range
Set RaBereich2 = Range("B1:B1006")
Set RaBereich2 = Intersect(RaBereich2, Range(Target.Address))
If Not RaBereich2 Is Nothing Then
Application.EnableEvents = False
For Each RaZelle2 In Range(Target.Address)
With RaZelle2
If (Len(.Value2) = 6 Or Len(.Value2) = 5) _
And IsNumeric(.Value2) Then
If Len(.Value2) = 6 Then
.Value = CDate(Mid(.Value2, 1, 2) _
& ":" & Mid(.Value2, 3, 2) & ":" _
& Mid(.Value2, 5, 2))
ElseIf Len(.Value2) = 5 Then
.Value = CDate(Mid(.Value2, 1, 1) _
& ":" & Mid(.Value2, 2, 2) & ":" _
& Mid(.Value2, 4, 2))
End If
.NumberFormat = "hh:mm:ss"
Application.EnableEvents = True
Else
.NumberFormat = "0"
End If
End With
Next RaZelle2
Application.EnableEvents = True
End If
Set RaBereich2 = Nothing
End Sub
Sub AusfüllenSpalteC()
With Intersect(Range("C1:C1006"), ActiveSheet.UsedRange)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
Der Scriptteil bezüglich Spalte A und Spalte B "Private Sub Worksheet_Change(ByVal Target As Range)" wird automatisch nach einer Benutzereingabe in einer Zelle der jeweiligen Spalte angewendet.
Der Makro "Sub AusfüllenSpalteC()" muss jedoch manuell in Excel über "Ansicht"→"Makros"→"Makros anzeigen"→"Ausführen" gestartet werden, wäre eine Automatisierung wie in den vorangegangegen Spalten, bzw. eine Auslegung über einen "Private Sub" möglich?
MfG
Michael
|