vba - 标题 2 文本与 excel : VBA 中的完全相同的文本不匹配

Question

我正在创建一个项目，允许用户在 excel 中创建任务列表，然后将用户创建的任务文本与预制 Word 文档中的第二个标题文本(标题 2)进行比较。我能够获取第二个标题文本并将其保存到数组中，然后获取用户任务列表并将其保存在数组中。然后我尝试使用该函数查看程序中的任务文本(第二个标题)是否在用户任务列表中

    If IsError(Application.Match(ProgArray(x), TaskArray, 0)) Then
        'Find within word document and highlight red
    End if

我遇到的问题是，这总是返回错误，因为出于某种原因，即使内置的监视屏幕调试器另有说明，word 文档中的文本也不等于 excel 表中的完全相同的文本。

起初，我使用比较文本软件来确定 word 中的标题文本实际上可能复制了额外的一行。
图片说明:

但后来我尝试修剪，并检查标题文本是否有 vbNewLine

    If Right$(StrFound, 2) = vbCrLf Or Right$(StrFound, 2) = vbNewLine Then

也无济于事，因为这个 if 语句从未被触发。

我的问题是，从 word 文档中获取文本是否还会提取一些我刚刚丢失的隐藏值，如果是这样，有什么办法解决这个问题吗？谢谢你，对不起文字墙。

最后这是我的完整代码:(它不漂亮，因为我现在只是为了功能)

'Sub CheckHeader()
Dim blnFound As Boolean
Dim StrFound As String
Dim x As Integer, y As Integer, z As Integer
Dim TaskTotal As Integer
Dim ProgArray(149) As String
Dim TaskArray() As String
Dim NotInArray() As String
Dim NotInProg() As String
Dim appWd As Object
Dim TaskSheet As Worksheet

Set appWd = GetObject(, "Word.Application")
Set wdFind = appWd.Selection.Find
Set TaskSheet = Sheets("Task List")

'Get Task List from Excel
TaskTotal = TaskSheet.Cells(TaskSheet.Rows.Count, 1).End(xlUp).Row - 1
ReDim TaskArray(TaskTotal) As String
ReDim NotInProg(TaskTotal) As String
ReDim NotInArray(TaskTotal) As String

'Get User task list into an array to compare - 0 to 0 is for testing
For x = 0 To 0 'TaskTotal - 1
    TaskArray(x) = TaskSheet.Cells(2 + x, 5).Value '+ " (" & TaskSheet.Cells(2 + x, 1).Value + " " _
        & TaskSheet.Cells(2 + x, 3).Value + ": " & TaskSheet.Cells(2 + x, 4).Value + ")"
Next x

x = 0
y = 0
'Find all instances of Headings
With ActiveDocument.Range.Find
    '.Text = "Test"
    .Style = "Heading 2"

    Do
        blnFound = .Execute
        If blnFound Then
            'MsgBox .Parent.Text
            StrFound = .Parent.Text
            'StrFound = Right(StrFound, InStr(StrFound, ")") + 1)
            StrFound = CStr(StrFound)
            TaskSheet.Cells(2 + x, 120).Value = StrFound
            'At first I thought it was also saving a new line but I couldn't get rid of it
            If Right$(StrFound, 2) = vbCrLf Or Right$(StrFound, 2) = vbNewLine Then
            z = 1
            End If
            ProgArray(x) = TaskSheet.Cells(2 + x, 120)
            'StrFound
            x = x + 1
        Else
            Exit Do
        End If
    Loop
    End With

       'Compare if List is in Program
     For x = 0 To 149
    If x < TaskTotal - 1 Then
        If IsError(Application.Match(TaskArray(x), ProgArray, 0)) Then
            NotInProg(y) = TaskArray(x)
            y = y + 1
        End If
    End If

    'If the header is not within the user created task list then run this case
    If IsError(Application.Match(ProgArray(x), TaskArray, 0)) Then
        'used for debugging, for some reason the header text is larger than the user text
        MsgBox StrComp(ProgArray(x), TaskArray(x))

        NotInArray(z) = ProgArray(x)
        SearchName = NotInArray(z)
        'Increase element
        z = z + 1
        'Check Program and highlight to show that what is in the program is not in the user task list
        With wdFind
            .Text = SearchName
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Execute
        End With
        If wdFind.Found Then
            'MsgBox " Found it"
            appWd.Selection.Range.HighlightColorIndex = wdRed
        Else
            MsgBox ProgArray(x) + " is not in TaskList"
        End If
    Else
        'Otherwise it is in the program and if it was red, unhighlight the text
        SearchName = TaskArray(x)
        With wdFind
            .Text = SearchName
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Execute
        End With
        If wdFind.Found Then
            'MsgBox " Found it"
            appWd.Selection.Range.HighlightColorIndex = wdNoHighlight

            ' For not in task Selection.Range.HighlightColorIndex = wdRed

            ' For not in prog Selection.Range.HighlightColorIndex = wdYellow
        Else
            MsgBox TaskArray(x) + " is not here"
        End If
    End If

     'Lastly Check for Ordering

     Next x

     End Sub'

Answer 1

您的代码中有两个问题，解决方案如下:

要剪切新的段落标记，我们需要以这种方式剪切它:

.Parent.SetRange .Parent.Start, .Parent.End - 1

您需要在之前放置:

StrFound = .Parent.Text

此外，添加 .Parent.MoveEnd在 x=x+1 之后在您的do...loop 内.