VBA阵列提取数据

时间:2016-08-10 16:22:43

标签: arrays excel vba excel-vba

如果省略“And not rng.Characters(iEnd,1).Font.Italic”中的“Not”,代码能够拉出斜体和带下划线的单词但是当我在代码中放置“Not”时拔出带下划线而不是斜体的单词它不起作用。我不确定为什么“不”不起作用。下面的图片是源表和带有提取数据的新工作表。我能够使用代码加下划线和斜体,但我添加了Not,所以我可以加下划线而不是斜体。应该出现的数据是标有1的图片中的第5行。

enter image description here

enter image description here

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

3 个答案:

答案 0 :(得分:4)

.Font.Underline未返回Boolean(True/False);)它会返回Long

如果添加Watch,您可以自己查看。

enter image description here

将您的代码更改为

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

答案 1 :(得分: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))

答案 2 :(得分:1)

您的代码正在截断最后一个字符。

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