Smilies in Zellen zählen/filtern

[Fennek]

Hallo,

aufbauend auf dem Code von Andre listet dieser Code ALLE Zeichen einer Zelle auf und macht sie damit einer weitergehenden Analyse zugänglich. Das Proble, dass die "mid()"-Funktion nicht klappt, ist damit umgangen.

Der Vorteil ist ein Vermeiden von 30 Spalten x 95.000 Zeilen mit Arrayformeln und "ein Wühlen in den Bytes".

Code:

Sub ReadSmilie()

Dim Ret() As Long
Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction
Tx = Cells(12, 1)
    
    ReDim Ret(Len(Tx))
    Do
        Ret(p) = WSF.Unicode(Tx)
        If Ret(p) < 65335 Then
           Tx = Mid(Tx, 2)
        Else
            Tx = Mid(Tx, 3)
        End If
        Debug.Print Ret(p)
        p = p + 1
    
    Loop While Len(Tx) > 0

End Sub

mfg

(hoffentlich ist das Projekt "politisch korrekt")

[Fennek]

Hallo,

es geht wohl auch mit M$ Word (schlecht getestet):

Code:

'https://stackoverflow.com/questions/38594807/how-to-process-multibyte-symbols-in-ms-word-vba
'getestet:
Private Sub Strip_PUA()
    For idx = 1 To ActiveDocument.Characters.Count
        Dim bArr() As Byte
        bArr = ActiveDocument.Characters(idx)

Debug.Print idx, Chr(bArr(b)), Right(0 & Hex(bArr(b + 1)), 2) & Right(0 & Hex(bArr(b)), 2)

    Next
End Sub

Dies ist der Probetext:

Code:

message
❤❤❤❤?
Cool
??????
Once in a lifetime ~ ♡
SN DE ❤️ :(
❤️
Glückwunsch ♥️????
Glückwunsch  ?
super schön ❤
Ja!!??
das ist blöd ??

mfg

[smima]

Hallo zusammen,

vielen Dank für die Hilfe!!

@Andre und Fennek: Es hat tatsächlich funktioniert und dabei hatte ich kaum noch Hoffnung. Ihr habt mir wirklich sehr viel Zeit erspart!

DANKE!!!

Liebe Grüße