Schreibweise automatisch ändern

[Petz1807]

Ehm ok vielen lieben Dank doch wie sezte ich dieses Makro genau ein?
Mit ALT+F11 ... und dann

[Fennek]

Hallo,

lege ein 2. Blatt für die Ergebnisse an.

Code:

Sub F_en()
Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction
Dim Dt As Date
Dim Bo As Boolean

For i = 1 To cells(rows.count,1).end(xlup).row
    Nam = Cells(i, 2)
    Geb = Cells(i, 3)
    Sheets(2).Cells(i, 1) = Cells(i, 4)
    
    Bo = InStr(1, Nam, Chr(10)) > 0
    If Bo Then
        Nm = Split(Nam, Chr(10))
        Ge = Split(Geb, Chr(10))
        For d = 0 To UBound(Ge)
            Ret = Ret & Cells(i, 1) & " " & Nm(d) & " née le " & WSF.Text(CDate(Ge(d)), "[$-40c]DD MMMM YYYY") & ", "
        Next d
    Else
        Ret = Cells(i, 1) & " " & Nam & " née le " & WSF.Text(CDate(Geb), "[$-40c]DD MMMM YYYY")
    End If
    Ret = Trim(Ret)
    If Right(Ret, 1) = "," Then Ret = Left(Ret, Len(Ret) - 1)
    Sheets(2).Cells(i, 2) = Ret
    
    Ret = ""
Next i
End Sub

mfg

[Petz1807]

Super toll du bist einfach spitze!
Jetzt muss ich nur noch den Familienname in kleinschrift umwandeln also erster Buchstabe gross rest klein

[Petz1807]

Sorry dass ich dich jetzt nochmal störe aber hatte eine abgespeckte Version meiner Tabelle hier raufgeladen eigentlich sind noch 2 weiter Spalten vor dem Namen die erste mit dem Datum wird aber nicht in Tabelle2 integriert

nur Spalte B soll nach Tabelle2 in Spalte C
Spalte C, D, E nach Tabelle2 in Spalte E
Spalte F nach Tabelle2 in Spalte A

Und eben der Familienname muss in kleinschrift sein

Glaub nicht dass es möglich ist das Jahr hinter dem 24/86 in Spalte G auszuschreiben 1986
resp. das Jahr wenn der odder die jüngste 18 Jahre bekommt in Spalte H zu setzen

Spalten B; F; I bleiben frei

Hab die Excel Datei in Anlage gesetzt

[Fennek]

Hallo,

prüfe bitte, ob das passt.

mfg

[Petz1807]

Ja das passt perfekt d.h. da werden auch die Jahre in Spalte G und H automatisch mit integriert...?

[Fennek]

Hallo,

für die gezeigte Datei funktioniert der Code, hoffentlich gibt es keine Unterschiede zur "großen" Datei.

mfg

[Petz1807]

Hallo,

Super doch das Problem besteht nur nor darin dass wenn mehrere Geburtsdatums in einer Zelle stehen dass dann das jüngste Geburtsdatum genommen wird und da +18 Jahre hinzugerechnet werden und dann in Spalte H eingetragen werden.

Was mir jetzt noch aufgefallen ist und jetzt nicht in der Tabelle noch stand ist die Situtation wenn 2 Familinenname in einer Zelle untereinander stehen dass er dann den Familienname zu dem Namen in der gleichen Zeile der Spalte nebenan nimmt zb:

16/10/201   10/88    LENTZ                    Alain           18/07/1980
                                                                     Carole         29/01/1981
                                      MUSTERMANN     Isabelle       04/10/1972

So dass das Ergebnis dann volgendermassen ist:

Lentz Alain née le 18 juillet 1980, Lentz Carole née le 29 janvier 1981, Mustermann Isabelle née le 04 octobre 1972

Die 2 Punkte sind jetzt sicher sehr schwierig zu realisieren odder?

[Fennek]

Hallo,

das Ändern des Jahres auf das jüngste Kind + 18 ist einfach und eingearbeitet.

Falls es mehrere Nachnamen gibt, müßte der Code sehr stark geändert werden:

Dieser Code läuft fehlerfrei durch, auch wenn es mehrere Nachnamen gibt, schreibt aber immer den ERSTEN Nachnamen in die Ausgabe-Liste. Die Zelle für dieses Problem wird in der Original-Liste gelb markiert und kann dann, sofern es nur wenige Fälle sind, von Hand korrigiert werden.

Falls es zu viele sind, muss der Code von Anfang an neu konzipiert werden.

Code:

Sub F_en()
Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction
Dim Dt As Date
Dim Bo As Boolean

Sheets("Tabelle1").Activate
With Sheets("Test")

   For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
       Mi = 0
       If InStr(1, Cells(i, 3), Chr(10)) = 0 Then
           FN = Cells(i, 3)
       Else
           FN = Split(Cells(i, 3), Chr(10))(0)
           Cells(i, 3).Interior.Color = vbYellow
       End If
       Nam = Cells(i, 4)
       Geb = Cells(i, 5)
       .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
       
       Bo = InStr(1, Nam, Chr(10)) > 0
       
       If Bo Then
           Nm = Split(Nam, Chr(10))
           Ge = Split(Geb, Chr(10))
           For d = 0 To UBound(Ge)
               Ret = Ret & WSF.Proper(FN) & " " & Nm(d) & " née le " & WSF.Text(CDate(Ge(d)), "[$-40c]DD MMMM YYYY") & ", "
               Mi = IIf(CDbl(CDate(Ge(d))) > Mi, CDbl(CDate(Ge(d))), Mi)
           Next d
       Else
           Ret = WSF.Proper(Cells(i, 3)) & " " & Nam & " née le " & WSF.Text(CDate(Geb), "[$-40c]DD MMMM YYYY")
           Mi = CDate(Cells(i, 5))
       End If
       Ret = Trim(Ret)
       If Right(Ret, 1) = "," Then Ret = Left(Ret, Len(Ret) - 1)
       
       .Cells(i + 2, 5) = Ret
       .Cells(i + 2, 8) = Year(Mi) + 18
       
       Ret = ""

   Next i
End With
End Sub

Der Code passt sich extrem an die gelieferte Datei an, alle möglichen Probleme sollten darin gezeigt werden. Die Tests wurden mit max. 2 Kindern pro Familie gemacht, auch wenn erwartet werden kann, dass es auch für mehr als 2 geht, muss dies gesondert geprüft werden.

mfg

[Fennek]

Hallo,

dieser Code sollte die Fälle mit mehreren Familiennamen lösen:

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


'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

mfg