Dieser Code hatte funktioniert, aber ich bin mir nicht sicher, warum VBA nicht mehr an dieser Zeile vorbeikommen kann. Ich erhalte den Laufzeitfehler '1004': Die Zeicheneigenschaft der Range-Klasse konnte nicht abgerufen werden. Jede Hilfe wird geschätzt.Die Zeichen konnten nicht ausgeführt werden Laufzeitfehler VBA
Option Explicit
Sub proj()
Dim dataRng As range, cl As range
Dim arr As Variant
Set dataRng = Worksheets("ItalicSourceSheet").range("C1:C5") '<--| change "ItalicSourceSheet" with your actual source sheet name
With Worksheets("ItalicOutputSheet") '<--|change "ItalicOutputSheet" with your actual output sheet name
For Each cl In dataRng
arr = GetItalics(cl) '<--| get array with italic words
If IsArray(arr) Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arr) + 1) = Application.Transpose(arr) '<--| if array is filled then write it down to output sheet first blank cell in column "A"
Next
End With
End Sub
Function GetItalics(rng As range) As Variant
Dim strng As String
Dim iEnd As Long, iIni As Long, strngLen As Long
strngLen = Len(rng.Value2)
iIni = 1
Do While iEnd <= strngLen
Do While rng.Characters(iEnd, 1).Font.Italic And rng.Characters(iEnd, 1).Font.Underline
If iEnd = strngLen Then Exit Do
iEnd = iEnd + 1
Loop
If iEnd > iIni Then strng = strng & Mid(rng.Value2, iIni, iEnd - iIni) & "|"
iEnd = iEnd + 1
iIni = iEnd
Loop
If strng <> "" Then GetItalics = Split(Left(strng, Len(strng) - 1), "|")
End Function
Verwenden Sie eine ältere Version von Excel? –
Ich benutze 2013. Es hatte funktioniert, aber plötzlich heute wirft es einen Fehler auf dieser Linie. – johndoe253
Welche Zellen und Arbeitsblätter bilden das 'rng' Objekt? –