Question

我正在创建一个项目，允许用户在excel中创建任务列表，然后将用户创建的任务文本与预先制作的word文档中的第二个标题文本（标题2）进行比较。我能够获取第二个头文本并将其保存到一个数组，然后获取用户任务列表并将其保存在一个数组中。然后我尝试使用函数

查看程序中的任务文本（第二个标题）是否在用户任务列表中

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

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

首先，我使用比较文本软件来确定标题文本中的文本可能实际上已复制了额外的行。说明图片： example here

但后来我尝试修剪，并检查标题文本是否有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。

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

1 个答案: