Schreibweise automatisch ändern

[Petz1807]

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

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

[Petz1807]

Hier die Tabelle so wie ich sie haben will und auch mit dem Makro bestens funktionniert doch kannst du mir bitte die Änderungen in den VBA hinzufügen vielen Dank

[Fennek]

Hallo,

Spalte einzufügen bzw den Inhalt zu löschen (Spalte A) läßt den VBA-Code kollabieren. Da die letzte Zeile abgefragt wird, darf es auch keine Daten "tief unten" (Zeile 7000) geben.

Wie gesagt, der Vorteil von VBA ist eine sehr enge Abstimmung mit den Daten und der Nachteil ist der selbe.

mfg