Clever-Excel-Forum

Normale Version: Kopieren mit Spaltenüberschriften
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2
Doch, vorher hat es funktioniert
Gruss Martin
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
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
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
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
Guten Tag ralf_b
98  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
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
Guten Abend ralf_b
98 für die Bereinigung. Jetzt läuft alles 35
Wünsche noch ne schöne Woche.
Gruss Martin
Seiten: 1 2