Question

不确定这只是我的电脑还是我的代码，但每次我尝试运行程序时，单词都会崩溃。基本上，我想要的是在表格中搜索标题标题（它们是唯一的粗体字）。我的代码在这里（抱歉缺少标记/解释，我对此很新，不知道如何/放什么）。关于我想要的代码是搜索每一行的粗体文本，如果该值是Y，那么它将在标题中搜索文本值。如果它是特定名称，那么它将自动搜索下一行。如果它是粗体但不是列出的名称之一，那么我想知道它是在文档的中间还是结尾（通过查看是否有任何粗体文本，即后面的标题和非粗体文本是无关紧要的）。非常感谢任何帮助，谢谢。

UIWebView

EDIT1 好的，所以已经处理了无限循环问题，但代码没有返回任何内容而不是我想要的值。我怀疑问题在于这个代码区域：

Application.ScreenUpdating = False
    Dim rng As Range
   Dim G As Integer
   For i = 1 To ActiveDocument.Tables(1).Rows.Count
Set rng1 = Selection.Range
With Selection.Range
With .Find
    With .Font
        .Bold = True
    End With
    .Text = ""
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .Execute
     Do While .Execute
        If Selection.Find.Font.Bold = True Then
          If Selection.Find.Text = "Organization" Or Selection.Find.Text = "Date" Or Selection.Find.Text = "Description" Or Selection.Find.Text = "Aerospace, Space & Defence" Or Selection.Find.Text = "Automotive" Or Selection.Find.Text = "Manufacturing" Or Selection.Find.Text = "Life Sciences" Or Selection.Find.Text = "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or Selection.Find.Text = "Regional Stakeholders" Or Selection.Find.Text = "Other Policy Priorities" Then
            G = 5
           Else
                Selection.Collapse Direction:=wdCollapseStart
                Selection.MoveDown Unit:=wdLine, Count:=1
                rng.SetRange Start:=Selection.Start, End:=ActiveDocument.Range.End
                rng.Select
                With Selection.Find
                    .ClearFormatting
                        With .Font
                            .Bold = True
                        End With
                    .Text = "Aerospace, Space & Defence" Or "Automotive" Or "Manufacturing" Or "Life Sciences" Or "Information Communication Technologies / Digital" Or "Natural Resources / Energy" Or "Regional Stakeholders" Or "Other Policy Priorities"
                    .MatchCase = True
                    .MatchWholeWord = True
                    If Selection.Find = True Then
                     MsgBox ("A category has been inserted into the middle of the document. Please copy manually or move extra category to the end of the document to continue automation.")
                        Exit Sub
                    ElseIf Selection.Find.Font.Bold = True Then
                     MsgBox ("There is more than one extra category. Please copy manually.")
                        Exit Sub
                    Else
                        rng.Select
                        Selection.Copy
                        ThisDocument.Activate
                        ThisDocument.Tables(1).Columns(1).Select
                        Selection.Collapse Direction:=wdCollapseEnd
                        Selection.PasteAndFormat (wdTableInsertAsRows)
                    End If
                End With
          End If
        Else
        G = 6
       End If
 Loop
 End With
 End With
 Next i
 Documents("Policy.docx").Close (SaveChanges = False)
 Application.ScreenUpdating = True
 End Sub

有什么想法吗？

使用嵌套if循环VBA搜索表时崩溃

0 个答案: