Excell-Zelle formatieren (VBA oder "suchen und ersetzen"?)

Moderator: ModerationP

Excell-Zelle formatieren (VBA oder "suchen und ersetzen"?)

Beitragvon kabiami » 23. Sep 2021, 09:22

Liebe Community,

ich hänge seit einigen Tagen an folgendem Problem:
Die in einem Feld hängenden Daten müssten aufgeteilt werden nach fett-geschriebenem, kursivem und dem Rest.
In den angehängten Bildern sieht man den IST-Zustand und wie es sein sollte. Im Idealfall sollten aus der einen Zelle dann mehrere entstehen (siehe Bild).

Kann mir jemand sagen, wie ich möglichst einfach ein Ergebnis wie im Bild rot markiert bekommen könnte? (es handelt sich um 4600 Einträge).

Vielen Dank im Voraus!

Bild

Bild
kabiami
 

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon thowe » 23. Sep 2021, 13:15

ich denke mir, du wirst eher eine Antwort erhalten, wenn du eine Beispieldatei zur Verfügung stellst. Niemand wird dein Excel nachbauen.

Ein Frage: wäre der Doppelpunkt "Senegal:" ein eventuell erkennbarer Trennpunkt, für das "aufdröseln....?
LG & ciao....

thowe
<think happy thoughts>
Hast du Milch für Kaffe? Ja, ich habe "Fettarme". Das sehe ich. Bekomme ich nun eine Milch?
Benutzeravatar
thowe
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 686
Registriert: 09. Jul 2007, 12:20
Wohnort: Graz

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon kabiami » 23. Sep 2021, 13:54

Vielen Dank für den Hinweis!
Der Doppelpunkt ist tatsächlich eine Indiz für eine Trennungsmöglichkeit. Wenn ich bei "suchen und ersetzen" jedoch diesen als Anhaltspunkt nehme, verschwindet anschließend die kursive Form der nachfolgenden Wörter - die ich ja aber auch als nächsten Trennungshinweis brauche.

Hier im Anhang nochmal die ganze Tabelle. Die relevanten Daten sind lediglich in der Spalte G zu finden und das Beispiel aus dem Screenshot ist G98.

Ich hoffe sehr, auf Hilfe :(
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
kabiami
Neuling
 
Beiträge: 2
Registriert: 23. Sep 2021, 13:51

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon daNorbert » 23. Sep 2021, 16:45

Trennen Aufgrund von Formatierungen in einer Zelle ist denke ich mit Boardmitteln (inkl. Makros) nicht wirklich möglich.
Eine Möglichkeit wäre folgende:

Da nur Spalte G relevant habe ich als Vorarbeit die anderen Spalten entfernt
Unbenannt.png


Öffne die Date mit einem ZIP Editor und öffne das File \xl\sharedStrings.xml im Excel als XLM Tabelle
Bild1.jpg


Jeweils, wo Spalte E leer ist, beginnt eine Neue Zeile
Bild2.jpg


Das lässt sich dann mit etwas Aufwand wieder in das Ursprüngliche Format bringen (Siehe Beispiel Excel)

LG
Norbert
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
daNorbert
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 938
Registriert: 09. Sep 2010, 14:20

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon slowboarder » 23. Sep 2021, 18:43

HI
"einfach" ist das was du da vor hast mit sicherheit nicht und wird für die ganze Tabelle einiges an Programmieraufwand erfordern.

mal für dich als Ansatz ein Code der für eine Zelle aus der Spalte G (kannst du angeben), den Zellinhalt anhand der Formatierung in die einzelnen Zellen aufbricht.
Dabei wird zunächst einmal ein Array erzeugt.
Dieses Array schreibt das Makro dann auf das Blatt Tabelle2.

vielleicht kannst du das als Ansatz verwenden.
Ist aber nicht besonders schnell.
Für längere Texte wie in G7 brauchst das schon mal im Minutenbereich.

Code: Alles auswählen
Sub test()
Dim Zelle As Range
Dim i As Long
Dim arr
Dim z As Long, s As Long
Dim checkZeileNeu As Boolean

Set Zelle = Sheets("Plants").Range("G98")

With Zelle
    ReDim arr(1 To 2, 1 To 1)
    z = 2
    s = IIf(.Characters(1, 1).Font.Bold, 0, 1)
    For i = 1 To Len(Zelle.Value)
        If .Characters(i, 1).Font.Bold Then
            If z = 2 Then
                z = 1
                s = s + 1
                ReDim Preserve arr(1 To 2, 1 To s)
            End If
        ElseIf .Characters(i, 1).Font.Italic Then
            If z = 1 Then
                z = 2
            Else
                If Not .Characters(i - 1, 1).Font.Italic Then
                    s = s + 1
                    ReDim Preserve arr(1 To 2, 1 To s)
                End If
            End If
        Else
            If .Characters(i - 1, 1).Font.Italic Then
                arr(z, s) = arr(z, s) & ":"
            End If
        End If
       
        arr(z, s) = arr(z, s) & .Characters(i, 1).Text
    Next
    arr = WorksheetFunction.Transpose(arr)
    Sheets("Tabelle2").Cells(1, 1).Resize(UBound(arr, 1), 2) = arr
End With

End Sub

die Formatierung geht natürlich verloren.
Deshalb füge ich, wenn der Kursive Text zu Ende ist, nochmal den Doppelpunkt ein.

Gruß Daniel
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 28449
Registriert: 18. Apr 2009, 13:33

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon HKindler » 24. Sep 2021, 09:23

Hi,

die Frage ist doch eher: wo kommt der Text denn her und wie kommt er ursprünglich in die Zelle? Ich denke es ist wesentlich sinnvoller dort anzusetzen. Eine Untersuchung innerhalb einer Excel-Zelle kann nur Buchstabe für Buchstabe erfolgen, was die Sache sehr langsam macht. Excel ist nun einmal eine Tabellenkalkulation und kein Layout-Programm.

Wenn der formatierte Text in Word wäre, dann könnte man z.B. nach fett oder italic suchen lassen. Und hätte dann sogleich den zusammenhängenden Text mit diesem Format, den man dann auf einen Schlag bearbeiten - z.B. irgendwohin kopieren - kann. Das wäre wesentlich effizienter.

Eventuell liegt das Original auch in einer Markup-Sprache (*.tex, *.hmtl, *.xml, etc) vor, dann würde ein relativ einfaches Parsen des Textes genügen. Dabei müsste man nur das Ende der jeweiligen Auszeichnung durch einen Spaltentrenner ersetzen oder ergänzen. Z.B. könnte man im Falle von html nach <\b> suchen und diese durch <\b><br> ersetzen. Damit hätte man ein Trennzeichen, ab dem eine neue Zelle gefüllt werden soll.
Gruß,
Helmut

----------------------------
Windows 10 Enterprise (64 Bit) / Office 365 ProPlus (32 Bit)
Benutzeravatar
HKindler
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6294
Registriert: 04. Jul 2013, 09:02
Wohnort: Schwarzwald

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon slowboarder » 24. Sep 2021, 13:19

Hi
hier mal ein Lösungansatz.
das folgende Makro baut die Beispieldatei nach dem Muster um, wie es im Bild in der Eingangsfrage für G98 gezeigt ist.

hierzu müssen dann die beiden folgenden Codes in ein allgemeines Modul (Modul1) übernommen werden.
Ausgeführt werden muss dann das Makro "Umwandeln".
Die Funktion "Array_aus_Text" wird dann vom Makro "Umwandeln" verwendet.
Das Makro kann direkt in der Beispieldatei angewendet werden.
mit längeren laufzeiten ist zu rechen, ein Text mit 1000 Zeichen braucht bei mir c.a. 75 sec, also kanns bei über 4000 Zeilen etwas dauern, vielleicht erstmal nur mit wenigen Zeilen testen (Ende = 10)

Code: Alles auswählen
Sub Umwandeln()
Dim arr
Dim ZeileQuelle As Long
Dim ZeileZiel As Long
Dim shQuelle As Worksheet
Dim shZiel As Worksheet
Dim Ende As Long


Set shQuelle = ActiveWorkbook.Sheets(1)
Set shZiel = Sheets.Add(after:=shQuelle)
Ende = shQuelle.UsedRange.Rows.Count


ZeileZiel = 1
For ZeileQuelle = 1 To Ende
    Application.StatusBar = "Zeile " & ZeileQuelle & " von " & Ende & Format(ZeileQuelle / Ende, " - 0%")
    shQuelle.Range("A:F").Rows(ZeileQuelle).Copy shZiel.Cells(ZeileZiel, 1)
    shQuelle.Range("H:M").Rows(ZeileQuelle).Copy shZiel.Cells(ZeileZiel, 9)
   
    Select Case ZeileQuelle
        Case 1 'Überschrift
            shQuelle.Range("G1").Copy shZiel.Range("G1")
            ZeileZiel = ZeileZiel + 1
        Case Else
            With shQuelle.Cells(ZeileQuelle, 7)
                If .Value = "" Then
                    ZeileZiel = ZeileZiel + 1
                Else
                    arr = Array_aus_Text(.Cells)
                    shZiel.Cells(ZeileZiel, 7).Resize(UBound(arr, 2), UBound(arr, 1)) = WorksheetFunction.Transpose(arr)
                    ZeileZiel = ZeileZiel + UBound(arr, 2)
                End If
            End With
    End Select
Next
Application.StatusBar = False
End Sub

Code: Alles auswählen
Private Function Array_aus_Text(Zelle As Range) As Variant

Dim i As Long
Dim arr
Dim z As Long, s As Long
Dim checkZeileNeu As Boolean
Dim txt As String
Dim Ende As Long
txt = Application.StatusBar

With Zelle
    ReDim arr(1 To 2, 1 To 1)
    z = 2
    s = IIf(.Characters(1, 1).Font.Bold, 0, 1)
    Ende = Len(Zelle.Value)
    For i = 1 To Ende
        Application.StatusBar = txt & " - Zelle: " & Format(i / Ende, "0%")
        If .Characters(i, 1).Font.Bold Then
            If z = 2 Then
                z = 1
                s = s + 1
                ReDim Preserve arr(1 To 2, 1 To s)
            End If
        ElseIf .Characters(i, 1).Font.Italic Then
            If z = 1 Then
                z = 2
            Else
                If Not .Characters(i - 1, 1).Font.Italic Then
                    s = s + 1
                    ReDim Preserve arr(1 To 2, 1 To s)
                End If
            End If
        Else
            If .Characters(i - 1, 1).Font.Italic Then
                arr(z, s) = arr(z, s) & ":"
            End If
        End If
       
        arr(z, s) = arr(z, s) & .Characters(i, 1).Text
    Next
   Array_aus_Text = arr
End With
End Function


gruß Daniel
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 28449
Registriert: 18. Apr 2009, 13:33

Re: Excell-Zelle formatieren (VBA oder "suchen und ersetzen"

Beitragvon kabiami » 27. Sep 2021, 19:09

Vielen Dank euch allen!

Tatsächlich haben mir die letzten beiden Codes von slowboarder zum perfekten Ergebnis verholfen :-)
kabiami
Neuling
 
Beiträge: 2
Registriert: 23. Sep 2021, 13:51


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 32 Gäste