Clever-Excel-Forum

Hallo Forum,
habe ein kleines Problem und bitte um Hilfe.
Ich habe eine Vornamenliste mit mehreren Namen in einer Zelle.
Wenn bei einem Vornamen ein * steht zB. (Meier*), dann sollte
der Vorname (links vom Stern) unterstrichen und der * entfernt werden.
Habe es mit Text in Spalten usw. versucht, aber nicht hingekriegt.
Wäre froh, wenn mir jemand helfen würde.
Mit freundlichen Grüssen
Martin

Hallo,

um die anderen etwas zu motivieren sage ich mal: Es geht nicht perfekt!

Code:
Sub F_en()

y = Columns(1).Replace(Chr(160), Chr(32))

For i = 2 To cells(Rows.Count, 1).Row

    pos = InStr(1, cells(i, 1), "*")

    If pos Then

        cells(i, "L") = cells(i, 1)

        Do

            p1 = InStrRev(Left(cells(i, 1), pos), " ")

            cells(i, "L") = Replace(cells(i, "L"), "*", "", , 1)

            If p1 < 0 Then p1 = 1

            cells(i, "L").Characters(p1, pos - p1).Font.Underline = xlUnderlineStyleSingle

            pos = InStr(1, cells(i, "L"), "*")

        Loop Until pos = 0

    End If

Next i

End Sub

In den Zeilen mit 2 "Sternchen" wird nur ein Name unterstrichen.

mfg

Fennek
wenn auch nicht ganz perfekt, das nimmt mir schon einige Arbeit ab.
Eventuell hat noch jemand ein Vorschlag wie man das machen kann,
sonst werde ich den Rest von hand bereinigen.
Werde mal ein wenig damit üben.
Mit dankbarem Gruss
Martin

Versuch mal folgendes:

Code:
    Dim lngEnd              As Long

    Dim lngStart            As Long

    Dim c                   As Excel.Range

    Const sSuchzeichen      As String = "*"

    Const sTrennzeichen     As String = " "

    For Each c In Range("A2", Cells(Rows.Count, 1).End(xlUp))

        With c

            While InStrRev(.Value, sSuchzeichen) > 0

                lngEnd = InStrRev(.Value, sSuchzeichen)

                lngStart = InStrRev(.Value, sTrennzeichen, lngEnd)

                .Characters(lngStart + 1, lngEnd - lngStart - 1).Font.Underline = True

                .Characters(lngEnd, 1).Delete

            Wend

        End With

    Next

Marco,
funktioniert einwandfrei.
Das ist Thumbsupsmileyanim

Besten Dank und Gruss
Martin

luna101

Fennek

luna101

Mase

luna101