Römische Ziffern bzw Textteil

[dzazopou]

Hallo zusammen,

habe folgende Herausforderung:

Habe eine Zelle mit Text. Im Text befinden sich Römische Ziffern. Die bekomme ich durch ein Makro in Arabische Ziffern geändert.
Da in der Zelle NICHT NUR die römische Ziffer ist. Ändert das Makro auch ALLE Is, Vs, Xs...

Beispiel:

Im III. Programm des TV Fernsehen läuft.......

Das Makro prüft nun die Zelle, nach den Zeichen(ketten): I,II,III,IV, V,VI und ändert die in 1,2,3,4,5,6

Ergebnis:

1m 3. Programm des T5 Fernsehen läuft....   

Leider 1:2 verloren...

Danke für kreative Ideen.

Gruß
Daniel

[LCohen]

=LET(x;
GLÄTTEN(TEIL(WECHSELN(A1;" ";WIEDERHOLEN(" ";499));SPALTE(A:AZ)*499-498;499));
WECHSELN(TEXTVERKETTEN(" ";;
WENN(IDENTISCH(x;GROSS(x))*ISTZAHL(-ARABISCH(WECHSELN(x;".";)));
WENN(ISTZAHL(SUCHEN(".";x));ARABISCH(LINKS(x;SUCHEN(".";x)-1))&".";ARABISCH(x));x));" 0";))

Falls Dein Satz länger als 499 Zeichen oder ca. 50 Wörter ist, könntest Du statt GLÄWEXWDH auch XMLFILTERN nehmen.

Warnung: Obige Formel ist relativ schmutzig und fehlerträchtig.

[volti]

Hallo,

gehen die Zahlen nur bis sagen wir mal 13?

Dann hier mal eine erste Idee dazu, ansonsten wird es komplizierter.....

Code:

Sub RoemischArabisch()
 Dim sText As String, sArabisch As String
 Dim sArr1() As String, sArr2() As String
 Dim i As Integer, j As Integer
 
 sText = "Im IX. und III. Programm des TV Fernsehen läuft die Nr. I, VI, und VII zum xten Mal zu viel ab XI!"
 
 sText = " " & sText & " "
 sArr1 = Split(" XII 12 XIII 13 XI 11 IX 9 VIII 8 VII 7 VI 6 IV 4 III 3 II 2 V 5 I 1 X 10")
 sArr2 = Split(" |.|!|,", "|")
 For i = 1 To UBound(sArr1) Step 2
   For j = 0 To 3
      sText = Replace(sText, " " & sArr1(i) & sArr2(j), " " & sArr1(i + 1) & sArr2(j))
   Next
 Next i
 sText = Mid$(sText, 2, Len(sText) - 1)
 Debug.Print sText
 
End Sub

_________
viele Grüße
Karl-Heinz

[LCohen]

Oh ha. Zu den XXXII. Olympischen Spielen soll der James Bond Film XXV gezeigt werden, ohne dass QE II im Helikopter sitzt. Und nun?

[Fennek]

Hallo,

noch eine Variante, allerdings nur für das genannte Beispiel getestet:

Code:

Const Tx As String = "Im III. Programm des TV Fernsehens läuft"

Sub T_1()
Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction
On Error Resume Next

tt = Split(Tx)
For i = 0 To UBound(tt)
    If tt(i) = UCase(tt(i)) Then
        If Right(tt(i), 1) = "." Then tt(i) = Left(tt(i), Len(tt(i)) - 1)
        If Err.Number = 0 Then
            tt(i) = WSF.Arabic(tt(i)) & "."
            Err.Clear
        End If
    End If
Next i
Debug.Print Join(tt)
End Sub

mfg

[volti]

Hier noch mal etwas nachgebessert....

Code:

Sub RoemischArabisch()
 Dim sText As String, sArr() As String, sArr2() As String, sArr3() As String
 Dim i As Integer, j As Integer

 sText = "Im IX. und III. Programm des TV Fernsehen läuft die Nr. MCLI, VI, und VII zum xten Mal zu viel ab CDXIII!"
 sArr = Split(sText)
 On Error Resume Next
 sArr3 = Split(" |.|!|,", "|")
 For i = 0 To UBound(sArr)
    For j = 0 To 3
       sArr2 = Split(sArr(i), sArr3(j))
       If UCase$(sArr2(0)) = sArr2(0) Then _
          sArr2(0) = Application.WorksheetFunction.Arabic(sArr2(0))
       sArr(i) = Join$(sArr2, sArr3(j))
    Next j
 Next i
 sText = Join$(sArr)
 Debug.Print sText
End Sub

_________
viele Grüße
Karl-Heinz

[dzazopou]

Wie LCohen schrieb, der Ausgangstext muss frei wählbar sein.
Trotzdem Danke

---

@LCOHEN:

Es genügt vollkommen die röm. Ziffern I - X zu berücksichtigen.

Allerdings sind mir bei deiner ganz guten Lösung zwei Dinge aufgefallen:

Die Formel macht aus:  01. Im III. Programm des TV Fernsehen läuft 02. Im I. läuft…       01. Im 3. Programm des TV Fernsehen läuft2. Im 1. läuft…

und sie markiert das ganze Blatt, besser wäre eine Zelle.

Wenn du da eine Idee hättest?

Sonst ist es eigentlich was ich suche.

[LCohen]

Ups ... da hast Du mich ja sofort kalt erwischt. Da ich A:AZ statisch genommen habe, statt etwas längeres dynamisches, musste ich die auffüllenden 0 0 0 ... des aufgeteilten Strings mit WECHSELN wegmachen, schmutzig und fehlerträchtig. Kann man natürlich auch anders.

[LCohen]

Ich habe auf die Beschränkung auf ein einziges Argument A1 verzichtet:

=LET(x;
GLÄTTEN(TEIL(WECHSELN(A1;" ";WIEDERHOLEN(" ";499));SEQUENZ(;LÄNGE(A1)-LÄNGE(WECHSELN(A1;" ";))+1)*499-498;499));
TEXTVERKETTEN(" ";;
WENN(IDENTISCH(x;GROSS(x))*ISTZAHL(-ARABISCH(WECHSELN(x;".";)));
WENN(ISTZAHL(SUCHEN(".";x));ARABISCH(LINKS(x;SUCHEN(".";x)-1))&".";ARABISCH(x));x)))

(1) Etwas kürzer, (2) ohne Längen-Beschränkung unterhalb Zellinhaltslänge und (3) nur mit einem Argument A1:

=LET(x;
XMLFILTERN("<a><b>"&WECHSELN(A1;" ";"</b><b>")&"</b></a>";"//b");
TEXTVERKETTEN(" ";;
WENN(IDENTISCH(x;GROSS(x))*ISTZAHL(-ARABISCH(WECHSELN(x;".";)));
WENN(ISTZAHL(SUCHEN(".";x));ARABISCH(LINKS(x;SUCHEN(".";x)-1))&".";ARABISCH(x));x)))