Microsoft Excel

Herbers Excel/VBA-Archiv

Kursiven Text aus Zelle extrahieren


Betrifft: Kursiven Text aus Zelle extrahieren von: Peter
Geschrieben am: 02.10.2019 20:40:49

Hallo zusammen,

ich habe hier schon viele nüztliche Tips gefunden, selber aber noch nichts eingestellt. Sollte ich daher gewisse Konventionen nicht einhalten, bin ich dankbar für entsprechende Hinweise. Nun zu meinem Problem.

ich habe eine Tabelle mit Zellen, die normalen (am Anfang) und kursiven (am Ende) Text enthalten. Der kursive Text soll ohne den normalen Text in eine zweite Zelle übertragen werden.
z.B.
A1= normaler Text, kursiver Text, der in einer weiteren Zelle z.B. A2 übertragen werden soll
A2= kursiver Text, der in einer weiteren Zelle z.B. A2 übertragen werden soll

ich dachte, kann es damit lösen (bei Zahlen funktioniert es einwandfrei):






Function isItalic(zelle As Range) As Boolean
isItalic = zelle.Font.Italic
End Function


Sub test()
Dim zelle As Range
Dim neu As String
Dim i As Integer

For Each zelle In Selection
For i = 1 To Len(zelle)
Select Case Mid(zelle, i, 1)
Case isItalic = True
neu = neu & Mid(zelle, i, 1)
End Select
Next i
zelle.Offset(0, 1).Value = neu
neu = ""
Next zelle
End Sub

Kann mir bitte vielleicht jemand sagen, wie ich das lösen kann?
Vielen Dank für eure Unterstützung!
Gruß Peter

  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: Daniel
Geschrieben am: 02.10.2019 20:57:57

Hi

Mal so auf die schnelle:
Deine Funktion isItalic prüft das Format der Zelle.
Wenn du das Format von einzelnen Zeichen innerhalb der Zelle prüfen willst, musst du anders vorgehen.

Wenn du wissen willst wie, dann formatiere mal von Hand in einer Zelle einzelne Zeichen in Italic.
Zeichne es mit dem Macrorecorder auf.
Aus dem aufgezeichneten Code solltest du dir ableiten können, wie du die Prüfung programmieren musst.

Gruß Daniel


  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: Peter
Geschrieben am: 02.10.2019 21:46:34

Hallo Daniel,

danke für den Tipp, das leuchtet ein.
ich habs jetzt mit dem Recorder aufgezeichnet und so versucht (s.u.), es kommt keine Fehlermeldung mehr, aber es passiert auch nichts.
Wie ich die die einzelnen Zeichen statt der Zelle korrekt anspreche, ist mir nicht ganz klar.

Sub test2()
Dim zelle As Range
Dim neu As String
Dim i As Integer

For Each zelle In Selection
    For i = 1 To Len(zelle)
        Select Case Mid(zelle, i, 1)
            Case ActiveCell.Characters(Start:=i, Length:=1).Font.Italic
                 neu = neu & Mid(zelle, i, 1)
        End Select
    Next i
    zelle.Offset(0, 1).Value = neu
    neu = ""
Next zelle
End Sub
sorry, vielleicht hat jemand einen konkreten Tipp für mich.
Vielen Dank schon mal!
gruß Peter


  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: Daniel
Geschrieben am: 02.10.2019 22:11:04

Hi

Du scheinst das Prinzip von Select Case noch nicht ganz verstanden zu haben.
Da die Eigenschaft Italic ein einfaches True/False ist, schreibe die Bedingungsprüfung lieber mit IF THEN.
Außerdem, mit MID() extrahiert du nur die Buchstaben, ohne jegliche Formatinformation.

Gruß Daniel


  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: Peter
Geschrieben am: 03.10.2019 08:00:40

Hallo Daniel,

scheint so zu sein ;) (Mein Wissen stammt aus Beispielen aus meinem VBA Buch, daher täuscht der Code vllt über meinen Wissensstand, aus dem Recorder und was so durch try und error schon funktioniert hat.)
Ich bleib dran, weiß jedoch noch nicht, wann ich dazu komme.
Danke dir!
Gruß Peter


  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: Peter
Geschrieben am: 03.10.2019 07:43:50

Hallo Daniel,

danke für den Tipp, das leuchtet ein.
ich habs jetzt mit dem Recorder aufgezeichnet und so versucht (s.u.), es kommt keine Fehlermeldung mehr, aber es passiert auch nichts.
Wie ich die die einzelnen Zeichen statt der Zelle korrekt anspreche, ist mir nicht ganz klar.

Sub test2()
Dim zelle As Range
Dim neu As String
Dim i As Integer

For Each zelle In Selection
    For i = 1 To Len(zelle)
        Select Case Mid(zelle, i, 1)
            Case ActiveCell.Characters(Start:=i, Length:=1).Font.Italic
                 neu = neu & Mid(zelle, i, 1)
        End Select
    Next i
    zelle.Offset(0, 1).Value = neu
    neu = ""
Next zelle
End Sub
sorry, vielleicht hat jemand einen konkreten Tipp für mich.
Vielen Dank schon mal!
gruß Peter


  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: EtoPHG
Geschrieben am: 03.10.2019 08:04:15

Hallo Peter,

versuchs mal ohne das überflüssige Select Case, nämlich so:

Sub test2()
Dim zelle As Range
Dim neu As String
Dim i As Integer

For Each zelle In Selection
    For i = 1 To Len(zelle)
        If zelle.Characters(Start:=i, Length:=1).Font.Italic Then neu = neu & Mid(zelle, i, 1)
    Next i
    zelle.Offset(0, 1).Value = neu
    neu = ""
Next zelle
End Sub
Gruess Hansueli


  

Betrifft: AW: Kursiven Text aus Zelle extrahieren von: Peter
Geschrieben am: 04.10.2019 21:28:49

Hallo Hansueli

klappt einwandfrei :)
Vielen Dank!

Gruß Peter


  

Betrifft: UDF für mehrere TextAuszeichnungsarten von: Luc:-?
Geschrieben am: 03.10.2019 18:46:34

Hallo, Peter;
vor 3 Jahren hatte ich auf eine UDF verwiesen, die ich vor 5 Jahren einem Projekt beigegeben hatte. Die UDF ist noch ausbaufähig, was sie auch in meiner aktuellen Version 1.3 (leider) immer noch ist:
https://www.herber.de/forum/archiv/1524to1528/1526779_EvaluateFunction.html#1526981
Bitte Hinweise beachten und auch die benötigte Enumeration zu übernehmen nicht vergessen!
Gruß, Luc :-?

„Der beste Beweis für intelligentes Leben im Universum ist, dass noch niemand versucht hat, Kontakt mit uns aufzunehmen.“ H.Lesch, 2018, Sonneberg
Deshalb Intelligenz steigern mit …



  

Betrifft: AW: UDF für mehrere TextAuszeichnungsarten von: Peter
Geschrieben am: 06.10.2019 17:06:45

Danke Luc, derzeit reicht es als Makro;
vielleicht versuche ich deinen Vorschlag, der doch ganz schön komplex aussieht.
gruß peter


  

Betrifft: Ist ja auch für mehrere Arten, u.a. TextFarben ... von: Luc:-?
Geschrieben am: 06.10.2019 17:20:30

…gedacht, Peter.
Luc :-?


Beiträge aus dem Excel-Forum zum Thema "Kursiven Text aus Zelle extrahieren"