Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.04.2024 08:33:05
Bei erneuter Suche alte Markierung löschen VBA
29.04.2024 06:38:10
CSV Uhrzeit die Differenz berechnen
28.04.2024 20:05:21
CreateObject auf MacOS
28.04.2024 18:33:31
Excel Fenster fixieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Einzelne Wort plus Wortfarbe zeigen

Einzelne Wort plus Wortfarbe zeigen
11.02.2023 09:43:06
Dieter(Drummer)
Guten Morgen VBA Spezilisten/innen.
Habe wiedermal ein Code Problem, dass manche wohl auch als "Spielerei" ansehen :-). Mich interessiert aber wie es geht.
Habe einen Code aus dem Internet, der ohne meine Anpassung jedes Wort aus aktiver Zelle zeigt, aber leider ohne die entsprechende Farbe (Colorindex) des Wortes
Mit der Bitte um Hilfe, wie Code richtig sein muss.
Meine Beispieldatei: https://www.herber.de/bbs/user/157779.xlsm
Code Ziel: In MsgBox zeigen
1) Einzelne Wort zeigen
2) Folgezeile die Farbe (ColoIndex) des Wortes
3) Folgezeile, nächtes Wort
3) Folgezeile die Farbe (ColoIndex) des Wortes
usw.
Bisheriger Code:
'https://www.denisreis.com/excel-vba-zeichenkette-aufteilen-und-zusammenfuegen-mit-split-und-join/
  • Sub StringZerlegen()
    Dim strText As String
    Dim vArray As Variant
    Dim i As Integer
    Dim r As Variant
    r = Selection.Font.ColorIndex
    strText = ActiveCell
    vArray = Split(strText, " ")
    For i = 0 To UBound(vArray)
    'mx angepasst auf MsgBox
    MsgBox ActiveCell.Font.ColorIndex & vArray(i)
    Next i
    vArray = Join(vArray, " ")
    MsgBox "Zelltext: " & vbLf & vArray
    End Sub

    • 8
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Einzelne Wort plus Wortfarbe zeigen
    11.02.2023 10:10:22
    hary
    Moin Dieter
    Meinst du es so?
    Sub StringZerlegen()
Dim strText As String, Ausgabe As String
Dim vArray As Variant
Dim i As Integer
strText = ActiveCell
vArray = Split(strText, " ")
  For i = 0 To UBound(vArray)
    Ausgabe = Ausgabe & vbLf & vArray(i) & "  " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.Color
  Next i
MsgBox "Zelltext: " & vbLf & Ausgabe
End Sub
    gruss hary
    AW: Danke Hary, prima Lösung
    11.02.2023 10:22:57
    Dieter(Drummer)
    Guten Morgen Hary,
    freut mch von dir zu hören/lesen und dein Code klappr prima nach meinen Vorstellungen
    Feinheiten kann ich noch selbst anpassen.
    Danke dir und noch eine schöne und erfolgreiche Zeit.
    Dieter(Drummer)
    Anzeige
    AW: Code etwas angepasst, klappt prima
    11.02.2023 15:10:25
    Dieter(Drummer)
    Hallo Hary,
    habe deinen perefekten Code etwas angepasst:
    1) Zusätzlichen Zeilenvorschub hinter Farbnummer
    2) Zusätzlich zu "Font.Color" noch RGB Farbnummer mit "Font.ColorIndex"
    angehängt. Klappt alles prima.
    Danke dir nochmal für deine Hilfe.
    Wünsche dir ein schönes Wochenende und natürlich auch allen Helfern/innen dieses excellenten Forums.
    Mein jetziger Code:
    'Herber: hary vom 11.02.2023 10:10:22
  • Sub StringZerlegen() 'Worte plus Farbananzeige
Dim strText As String, Ausgabe As String
Dim vArray As Variant
Dim i As Integer
strText = ActiveCell
vArray = Split(strText, " ")
  For i = 0 To UBound(vArray)
    'Mx Anpassung mit RGB Farbnummer
    Ausgabe = Ausgabe & vbLf & " " & vbLf & "Textteil: " & vbLf & vArray(i) & "  " & vbLf & " FarbIndex: " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.Color & vbLf & " Farbnummer RGB: " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.ColorIndex
  Next i
MsgBox "Textteil(e) aktive Zelle " & vbLf & Ausgabe, , "Textteile - Farbindex"
End Sub

    • Anzeige
    AW: Nochmal angepasst mit Angabe der aktiven Zelle
    11.02.2023 15:46:02
    Dieter(Drummer)
    Hallo Hary,
    nur zur Vervollständigung und evtl. Nutzen für andere Forumsteilnehmer/innen und Interessenten.
    Habe noch die Anzeige der aktiv genutzen Zelladresse mit eingebaut und wird in MsgBox mit angezeigt:
    Gruß, Deter(Drummer)
    Jetziger, für mich jetzt fertiger Code Dank deiner Hilfe:
    'Herber: hary vom 11.02.2023 10:10:22
  • Sub StringZerlegen() 'Worte plus Farbananzeige
Dim strText As String, Ausgabe As String
Dim vArray As Variant
Dim i As Integer
strText = ActiveCell
vArray = Split(strText, " ")
  For i = 0 To UBound(vArray)
    'Mx Anpassung mit RGB Farbnummer und Zelladresse
    Ausgabe = Ausgabe & vbLf & " " & vbLf & "Textteil: " & vbLf & vArray(i) & "  " & vbLf & " FarbIndex: " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.Color & vbLf & " Farbnummer RGB: " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.ColorIndex
  Next i
MsgBox "Textteil(e) aktive Zelle: " & ActiveCell.Address & Ausgabe, , "Textteile - Farbindex"
End Sub

    • Anzeige
    AW: Bitte um Code Erweiterung
    11.02.2023 17:24:11
    Dieter(Drummer)
    Hallo Hary,
    würdest du mir bitte den Code noch um folgendes erweitern:
    Nach jeder MsgBox Ausgabezeile: "Farbnummer RGB: 10" z.B., zusätzlich eine Folgezeile, mit der Anzeige der entsprechenden Farben dezimal, "RGB: rot 255, grün 000, blau 000", z.B.bei rot.
    Wäre toll, wenn du da nochmal helfen kannst.
    Mit der Bitte um Hilfe,
    Gruß, Dieter(Drummer)
    Beispieldatei: https://www.herber.de/bbs/user/157787.xlsm
    Jetziger Code:
    'Herber: hary vom 11.02.2023 10:10:22
  • Sub StringZerlegen() 'Worte plus Farbananzeige
Dim strText As String, Ausgabe As String
Dim vArray As Variant
Dim i As Integer
strText = ActiveCell
vArray = Split(strText, " ")
  For i = 0 To UBound(vArray)
    'Mx Anpassung mit RGB Farbnummer und Zelladresse
    Ausgabe = Ausgabe & vbLf & " " & vbLf & "Textteil: " & vbLf & vArray(i) & "  " & vbLf & " FarbIndex: " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.Color & vbLf & " Farbnummer RGB: " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.ColorIndex
  Next i
MsgBox "Textteil(e) aktive Zelle: " & ActiveCell.Address & Ausgabe, , "Textteile - Farbindex"
End Sub

    • Anzeige
    AW: Bitte um Code Erweiterung
    12.02.2023 09:47:13
    hary
    Moin Dieter
    Dim Farbe As Long, R As Integer, G As Integer, B As Integer
Dim strText As String, Ausgabe As String
Dim vArray As Variant
Dim i As Integer
strText = ActiveCell
vArray = Split(strText, " ")
  For i = 0 To UBound(vArray)
  Farbe = ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.Color
    R = Farbe And 255
    G = (Farbe \ 256) And 255
    B = Farbe \ 65536
    'Mx Anpassung mit RGB Farbnummer und Zelladresse
    Ausgabe = Ausgabe & vbLf & " " & vbLf & "Textteil: " & vbLf & vArray(i) & "  " & vbLf & " FarbIndex: " & Farbe & vbLf & " Farbnummer RGB: " & "Rot(" & R & ")" & " Gruen(" & G & ")" & " Blau(" & B & ")"
  Next i
MsgBox "Textteil(e) aktive Zelle: " & ActiveCell.Address & Ausgabe, , "Textteile - Farbindex"
    gruss hary
    Anzeige
    AW: Perfekter Code
    12.02.2023 12:06:03
    Dieter(Drummer)
    Hallo Hary,
    herzlichen Dank für den erweiteretn Code, der wie gewünscht funktioniert.
    Hatte garnicht mehr damit gerechnet, dass mir da nochmal geholfen wird.
    Werde mir im Codebereich, über Direktfenster, jeden Einzelschritt des Makros ansehen.
    Ich bin begeistert :-)
    Danke nochmal und einen schönen und erfolgreichen Sonntag.
    Gruß, Dieter(Drummer)
    AW:Jetzt fertige Codelösung
    12.02.2023 16:44:26
    Dieter(Drummer)
    Hallo hary,
    hier ist jetzt der fertige Code, der prima funktioniert.
    Danke nochmal und Gruß,
    Dieter(Drummer)
    'Herber: hary vom 12.02.2023 09:47:13
'Mx, kleine Anpassungen 12.02.2023 16:00:00
Sub StringZerlegen_RGB() 'Worte + Farbananzeige + RGB
Dim Farbe As Long, R As Integer, G As Integer, B As Integer
Dim strText As String, Ausgabe As String
Dim vArray As Variant
Dim i As Integer
strText = ActiveCell
vArray = Split(strText, " ")
  For i = 0 To UBound(vArray)
  Farbe = ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.Color
    R = Farbe And 255
    G = (Farbe \ 256) And 255
    B = Farbe \ 65536
    'Mx Anpassung mit RGB Farbnummer und Zelladresse
    Ausgabe = Ausgabe & vbLf & " " & vbLf & "Textteil: " & vbLf & vArray(i) & "  " & vbLf & " FarbNummer: " & " " & Farbe & vbLf & " Farbindex: " & " " & ActiveCell.Characters(InStr(1, strText, vArray(i)), Len(vArray(i))).Font.ColorIndex & vbLf & " RGB Farben Dezimal: " & "Rot (" & " " & R & " " & ")" & " Grün (" & " " & G & " " & ")" & " Blau (" & " " & B & " " & ")"
    Next i
MsgBox "Textteil(e) aktive Zelle: " & ActiveCell.Address & Ausgabe & vbLf & vbLf & vbLf & "Erstellt Excel-Forum Herber: hary 12.02.2023" & vbLf & "Anpassungen: Dieter(Drummer) 12.02.2023", vbInformation, "Textteil(en) - Farbe(n)"
End Sub

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige