Данные экстракции массива VBA

Question

Когда «Not» in «And Not rng.Characters (iEnd, 1) .Font.Italic» отсутствует, код способен вытаскивать курсивом и подчеркнутыми словами, но когда я помещаю «Не», в коде, чтобы вытащить подчеркнутые, а не курсивные слова, он не работает. Я не совсем уверен, почему «Не» не будет работать. Ниже представлены исходные тексты и новый лист с извлеченными данными. Я могу использовать код, чтобы получить подчеркнутый и выделенный курсивом, но я добавляю «Не так», чтобы я мог подчеркнуть, но не выделен курсивом. Данные, которые должны выйти в линию 5 из картины с надписью 1.

Sub extract()   
 
    Dim dataRng As Range, cl As Range 
 
    Dim marr As Variant 
 
    
 
    Set dataRng = Worksheets("Sheet1").Range("C1:C10") 
 
    
 
    With Worksheets("Sheet2") 
 
     For Each cl In dataRng 
 
      marr = GetUnderlines(cl) 
 
      If IsArray(marr) Then .Cells(.Rows.Count, 4).End(xlUp).Offset(1).Resize(UBound(marr) + 1) = Application.Transpose(marr) 
 
     Next 
 
    End With 
 
    
 
End Sub 
 
Function GetUnderlines(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.Underline And Not rng.Characters(iEnd, 1).Font.Italic 
 
      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 GetUnderlines = Split(Left(strng, Len(strng) - 1), "|") 
 

 
End Function

Answer 1

.Font.Underline не возвращают Boolean(True/False);) Это возвращается Long

Если вы добавите Watch, вы можете это увидеть сами.

Изменить код

Do While rng.Characters(iEnd, 1).Font.Underline = xlUnderlineStyleSingle _ 
And Not rng.Characters(iEnd, 1).Font.Italic 

Answer 2

Изменение в то время как условия для этого:

Подчеркивание не boolean.

Do While (rng.Characters(iEnd, 1).Font.Underline = -4142 Or _ 
       (rng.Characters(iEnd, 1).Font.Underline = 2 And _ 
       Not rng.Characters(iEnd, 1).Font.Italic)) 

Answer 3

Ваш код обрезает последний символ.

Function GetUnderlines(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.Underline = xlUnderlineStyleSingle And Not rng.Characters(iEnd, 1).Font.Italic And rng.Characters(iEnd, 1).Text <> " " 
      iEnd = iEnd + 1 
      If iEnd > strngLen Then Exit Do 
     Loop 

     If iEnd > iIni Then 
      strng = strng & Mid(rng.Value2, iIni, iEnd - iIni) & "|" 

     End If 
     iEnd = iEnd + 1 
     iIni = iEnd 
    Loop 

    If strng <> "" Then GetUnderlines = Split(Left(strng, Len(strng) - 1), "|") 

End Function