Kopieren mit Spaltenüberschriften

[luna101]

Doch, vorher hat es funktioniert
Gruss Martin

[luna101]

Hallo Makro Spezi's
Bitte um Hilfe, das Problem, umwandeln von
"BEF", "AFT" usw. nach "vor ", "nach ", usw. zu lösen.
Wäre toll, wenn das auch noch funktionieren würde.
Gruss Martin

[ralf_b]

der Code  für das Ersetzen ist doch genau der Selbe.

Code:

Dim cell as Range ' nicht vergesssen  
For Each cell In rng
            cell.Replace "BEF.", "vor "
            cell.Replace "BEF..", "vor "
            cell.Replace "AFT.", "nach "
            cell.Replace , "AFT..", "nach "
            cell.Replace "ABT.", "um "
            cell.Replace "ABT..", "um "
            If Mid(cell, 2, 1) = "." Then cell.Value = "0" & cell.Value
          Next

[luna101]

Guten Tag ralf_b
entschuldige, dass ich erst jetzt antworte. Habe versucht, zu ergründen,
wieso das Umwandeln nicht funktionierte. Leider ohne Erfolg. Darum habe
ich einen andern Weg versucht und jetzt funktioniert es, mit 2 kleinen
Schönheitsfehlern. Ich hoffe, ihr helft mir, diese zu bereinigen.

Schönheitsfehler 1: Bei den Datum sollten die Tage 1  - 9 auch zweistellig sein. (zB. 01 02 03 usw)

Schönheitsfehler 2: In der letzten Zeile sollten die Datum auch eingetragen werden.

Mitdankbaren Grüssen
Martin

[ralf_b]

Code:

Sub Daten_Ersetzen()

    Dim lsecondGeb
    Dim sSuche(2)
    Dim sWort
   ' Dim Monate
    Dim rngCell As Range
 
   
    'Monate = Application.GetCustomListContents(3)

    sSuche(0) = Array("Geburtsdatum", "AD")
    sSuche(1) = Array("Heiratsdatum", "AF")
    sSuche(2) = Array("Todesdatum", "AH")
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    With Worksheets("Tabelle1")
                 
        lastRow = .Cells(.Rows.Count, "BU").End(xlUp).Row
        lastRow = lastRow - 6
        For Each sWort In sSuche
            lsecondGeb = Application.Match(sWort(0), .Rows(6), 0)
           
            Set rng = .Range(sWort(1) & "7").Resize(lastRow)
           
            rng.Value = .Cells(7, lsecondGeb).Resize(lastRow).Value
           
            rng.Replace " ", ".", xlPart
            rng.Replace What:="BEF.", Replacement:="vor ", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False

            rng.Replace What:="AFT.", Replacement:="nach ", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False

            rng.Replace What:="ABT.", Replacement:="um ", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                               
            For Each rngCell In rng
                If IsDate(rngCell) Then
                    rngCell.NumberFormat = "DD.MM.YYYY"
                    rngCell.Value = Format(rngCell.Value, "DD.MM.YYYY")
                End If
            Next
       
        Next
    End With
   
    Application.ScreenUpdating = True
    Application.EnableEvents = True
   
End Sub

[luna101]

Guten Tag ralf_b
 für das Update. Das Umwandeln von "BEF" usw. funktioniert,
jedoch werden die Datum in der Spalte "Heiratsdatum" nicht umgewandelt.
Dürfte ich nochmals um Hilfe bitten?
Gruss Martin

[ralf_b]

Das liegt wohl daran das Excel nicht versteht das MAY der Mai ist.  Ist nunmal Englisch.  Dann füge den Code noch dazu unter die anderen rng.Replace

Code:

           rng.Replace What:="mar", Replacement:="Mrz", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
           
            rng.Replace What:="may", Replacement:="Mai", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                                                             
            rng.Replace What:="oct", Replacement:="Okt", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
           
            rng.Replace What:="dec", Replacement:="Dez", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False

[luna101]

Guten Abend ralf_b
für die Bereinigung. Jetzt läuft alles
Wünsche noch ne schöne Woche.
Gruss Martin