20.11.2018, 14:17
Hallo,
Ist es möglich diesem Makro noch eine Zeile hinzuzufügen so dass fals kein Geburtsdatum vorhanden ist der Script nicht hängen bleibt sondern einfach weiter bis zum Schluss läuft
Vielen lieben dank
Ist es möglich diesem Makro noch eine Zeile hinzuzufügen so dass fals kein Geburtsdatum vorhanden ist der Script nicht hängen bleibt sondern einfach weiter bis zum Schluss läuft
Vielen lieben dank
Code:
Sub T_1()
Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction
Dim Geb() As Date
Dim B_D As Boolean
Dim B_C As Boolean
Sheets(1).Activate
With Sheets("Test")
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
ju = 0
.Cells(i + 2, 1) = Cells(i, 6)
.Cells(i + 2, 3) = Cells(i, 2)
Ext = Split(Cells(i, 2), "/")(1)
Jh = IIf(Val(Ext) > 50, "19", "20")
Ext = Jh & Ext
.Cells(i + 2, 7) = Ext
If InStr(1, Cells(i, 4), Chr(10)) > 0 Then
B_D = True
Nm = Split(Cells(i, 4), Chr(10)) 'Vornamen
Ge = Split(Cells(i, 5), Chr(10)) 'Geburt
ReDim Geb(UBound(Ge))
For d = 0 To UBound(Ge)
Geb(d) = CDate(Ge(d))
ju = IIf(Geb(d) > ju, Geb(d), ju)
Next d
Else
B_D = False
End If
If InStr(1, Cells(i, 3), Chr(10)) > 0 Then B_C = True Else B_C = False
'1 Kind
If Not B_D Then
.Cells(i + 2, 5) = WSF.Proper(Cells(i, 3)) & " " & Cells(i, 4) & " né(e) le " & WSF.Text(CDate(Cells(i, 5)), "[$-40c]DD MMMM YYYY")
.Cells(i + 2, 8) = Year(CDate(Cells(i, 5))) + 18
End If
'1 Familienname, mehrere Kinder
If B_D And Not B_C Then
For d = 0 To UBound(Nm)
Nm(d) = WSF.Proper(Cells(i, 3)) & " " & Nm(d) & " née le " & WSF.Text(CDate(Geb(d)), "[$-40c]DD MMMM YYYY")
Next d
.Cells(i + 2, 8) = Year(ju) + 18
.Cells(i + 2, 5) = Join(Nm, ", ")
End If
'mehrere Familiennamen, mehrere Kinder
If B_C And B_D Then
FN = Split(Cells(i, 3), Chr(10))
For d = 1 To UBound(FN)
If FN(d) = "" Then FN(d) = FN(d - 1)
Next d
For d = 0 To UBound(Nm)
Nm(d) = WSF.Proper(FN(d)) & " " & Nm(d) & " née le " & WSF.Text(CDate(Geb(d)), "[$-40c]DD MMMM YYYY")
Next d
.Cells(i + 2, 8) = Year(ju) + 18
.Cells(i + 2, 5) = Join(Nm, ", ")
End If
Next i
End With
End Sub