使用 Find VBA 宏循环到下一个范围

Question

我正在尝试编写一个宏来查找单词（表 1-1），然后查找文档中的下一个单词（表 2-1）并将表 1-1 格式化为实际的单词表。我已经弄清楚了那部分并且工作得很好。

这是我似乎无法开始工作的循环部分。我希望它移动到下一个范围以找到从（表 2-1）到（表 3-1）的表集。我希望它对文档中的每个表都执行此操作，直到它遍历所有表。

代码如下：

Sub FindTableFormatIt()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim strTheText As String
    Dim tableEach As Table
    Dim i As Long


    For i = 1 To 100
    Set rng1 = ActiveDocument.Range


            If rng1.Find.Execute(FindText:="Table") Then
                Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
                    If rng2.Find.Execute(FindText:="Table") Then
                        Set rng3 = ActiveDocument.Range(rng1.Start, ActiveDocument.Range.End)
                        ActiveDocument.Range(rng3.Start, rng2.Start).ConvertToTable

                    End If
            End If
    Next i          
End Sub

这是word文档的样子。

Table 1-1
Q1. When there is an election for president do you always vote, almost always vote, vote most of the time, vote some of the time, hardly ever vote, or never vote?

                              Total
                             -------

Total                            600
Always                          87.8
Almost always                    6.0
Most of time                     4.3
Sometimes                        2.0

Table 2-1
Q2. For statistical purposes, what is your age?

                              Total
                             -------

Total                            600
18-34                           21.2
     18-29                      13.5
     30-34                       7.7

35-44                           18.1
     35-39                       8.8
     40-44                       9.4

45-54                           16.4

55-64                           18.6
     55-60                      10.9
     61-64                       7.6

65+                             25.7
Mean                            50.0

Table 3-1
Q3. Gender:
(NET DIF 1 - Percent male minus percent female)

                              Total
                             -------

Total                            600
Male                            48.0
Female                          52.0
NET DIF 1                       -4.0

Table 4-1
Q4. If you had to label yourself, would you say you are a liberal, a moderate or a conservative in your political beliefs?
(NET DIF 1 - Percent Conservative minus percent Liberal)

                              Total
                             -------

Total                            600
Liberal                         28.4
     Very Liberal               12.9
     Somewhat Liberal           15.4

Moderate                        31.1

Conservative                    35.3
     Somewhat Conservative      14.7
     Very Conservative          20.6

DK/Refused                       5.3
NET DIF 1                        7.0

Answer 1

我终于有了一个编码解决方案。这将正确地将每个文本循环并格式化到适当的表格范围内，并将它们隔开，以免表格溢出到两页上。

Sub FindTableFormatIt()

Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim pagenum As Integer



Set rng1 = ActiveDocument.Range
pagenum = 1



Do Until Not rng1.Find.Execute(FindText:="(^13)<Table>", MatchWildcards:=True)
    Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)



    If rng2.Find.Execute(FindText:="(^13)<Table>", MatchWildcards:=True) Then
        If rng2.Information(3) > pagenum Then
            Set rng3 = ActiveDocument.Range(rng1.Start - 1, rng1.Start - 1)
            rng3.InsertBreak (wdPageBreak)
            pagenum = rng2.Information(3)
        End If



        ActiveDocument.Range(rng1.Start, rng2.Start - 1).ConvertToTable
        Set rng1 = ActiveDocument.Range(rng2.Start, ActiveDocument.Range.End)

    Else

        If rng2.Information(3) > pagenum Then
            Set rng3 = ActiveDocument.Range(rng1.Start - 1, rng1.Start - 1)
            rng3.InsertBreak (wdPageBreak)
            pagenum = rng2.Information(3)

        End If



        ActiveDocument.Range(rng1.Start, ActiveDocument.Range.End).ConvertToTable
        Set rng1 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)

    End If

 Loop
End Sub

Answer 2

试试：

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertAfter Chr(12)
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Table"
    .Replacement.Text = "^p^12Table"
    .Forward = True
    .Format = False
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
    .Text = "Table*^12"
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    .Characters.Last.Delete
    .Start = .Paragraphs(2).Range.End
    .ConvertToTable vbTab
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub