VBA

Question

我有一堆 word 文档，每个文档都包含一个 table，其中一些包含大量数据（可能超过 20,000 行），因此可能长达数百页。

话虽如此，我发现了一个 VBA 单词宏，它可以显示从每一页开始的所有行索引。例如，对于延伸 100 页的 table，宏将显示 100 个整数。这正是我所需要的，但由于各种原因，宏运行速度很慢。此外，当我调整代码并将其嵌入到 excel 宏（用于单词对象）时，它运行得更慢。

所以我的问题是 - 这个宏可以以某种方式优化吗？我想循环是导致问题的原因。非常感谢您的意见！

Sub TableRowData()
    'define meaningful names to use for array's first dimension
    Const pgnum = 1
    Const startrow = 2
    Const endrow = 3

    Dim data() As Long  ' array to hold data
    Dim rw As Row       ' current row of table
    Dim rownum As Long  ' the index of rw in table's rows
    Dim datarow As Long ' current value of array's second dimension
    Dim rg As Range     ' a range object for finding the page where rw starts

    'initialization
    ReDim data(3, 1)
    Set rw = ActiveDocument.Tables(1).Rows(1)
    rownum = 1
    datarow = 1

    'store the page number and row number for the first row of the table
    Set rg = rw.Range
    rg.Collapse wdCollapseStart
    data(pgnum, datarow) = rg.Information(wdActiveEndAdjustedPageNumber)
    data(startrow, datarow) = rownum

    'Step through the remaining rows of the table.
    'Each time the page number changes, store the preceding row as the
    'last row on the previous page; then expand the array and store the
    'page number and row number for the new row.
    While rownum < ActiveDocument.Tables(1).Rows.Count
        Set rw = rw.Next
        rownum = rownum + 1
        Set rg = rw.Range
        rg.Collapse wdCollapseStart
        If rg.Information(wdActiveEndAdjustedPageNumber) > data(pgnum, datarow) Then
            data(endrow, datarow) = rownum - 1
       
            ReDim Preserve data(3, datarow + 1)
            datarow = datarow + 1
            data(pgnum, datarow) = rg.Information(wdActiveEndAdjustedPageNumber)
            data(startrow, datarow) = rownum
        End If
    Wend

    'finish up with the last row of the table
    data(endrow, datarow) = rownum
     
    Dim msg As String
    Dim i As Long
    For i = 1 To UBound(data, 2)
        msg = msg & data(startrow, i) & vbCr
    Next i
    MsgBox msg
End Sub

Answer 1

逐行处理 table 是出了名的慢，您几乎无能为力。

关闭屏幕更新会有帮助。在例程的开头添加 Application.ScreenUpdating = False 并在末尾添加 Application.ScreenUpdating = True.

您可以尝试的另一件事是使用 For Each 循环。对于这种方法是否更快，存在一些分歧。有一个大的 table 来处理会让你很清楚哪个是更快的方法，但不要指望奇迹。无论采用哪种方法，都需要耐心。

Sub TableRowData()
    Application.ScreenUpdating = False
    'define meaningful names to use for array's first dimension
    Const pgnum = 1
    Const startrow = 2
    Const endrow = 3

    Dim data() As Long  ' array to hold data
    Dim rw As Row       ' current row of table
    Dim rownum As Long  ' the index of rw in table's rows
    Dim datarow As Long ' current value of array's second dimension
    'Dim rg As Range     ' a range object for finding the page where rw starts

    'initialization
    ReDim data(3, 1)
    Set rw = ActiveDocument.Tables(1).Rows(1)
    rownum = 1
    datarow = 1

    'store the page number and row number for the first row of the table
    Set rg = rw.Range
    rg.Collapse wdCollapseStart
    data(pgnum, datarow) = rg.Information(wdActiveEndAdjustedPageNumber)
    data(startrow, datarow) = rownum

    'Step through the remaining rows of the table.
    'Each time the page number changes, store the preceding row as the
    'last row on the previous page; then expand the array and store the
    'page number and row number for the new row.
    'While rownum < ActiveDocument.Tables(1).Rows.Count
    For Each rw In ActiveDocument.Tables(1).Rows
        'Set rw = rw.Next
        rownum = rownum + 1
        'Set rg = rw.Range
        'rg.Collapse wdCollapseStart
        If rw.Range.Information(wdActiveEndAdjustedPageNumber) > data(pgnum, datarow) Then
            data(endrow, datarow) = rownum - 1
       
            ReDim Preserve data(3, datarow + 1)
            datarow = datarow + 1
            data(pgnum, datarow) = rw.Range.Information(wdActiveEndAdjustedPageNumber)
            data(startrow, datarow) = rownum
        End If
    Next rw
    'Wend

    'finish up with the last row of the table
    data(endrow, datarow) = rownum
     
    Dim msg As String
    Dim i As Long
    For i = 1 To UBound(data, 2)
        msg = msg & data(startrow, i) & vbCr
    Next i
    MsgBox msg
    Application.ScreenUpdating = True
End Sub

Answer 2

遍历页面并获取行号如何？

这样行吗？

Dim doc As Document
Dim rng As Range
Dim pg As Long

    Application.ScreenUpdating = False

    Set doc = ThisDocument
    
    
    For pg = 1 To doc.Range.Information(wdNumberOfPagesInDocument)
        Set rng = doc.GoTo(wdGoToPage, wdGoToAbsolute, pg)
        Debug.Print rng.Information(wdEndOfRangeRowNumber)
    Next pg

Answer 3

尝试一些基于：

Sub TableRowData()
Dim Doc As Document, Rng As Range, Data() As Long, i As Long, j As Long, p As Long, r As Long, x As Long
Set Doc = ActiveDocument
With Doc
  With .Tables(1).Range
    i = .Cells(1).Range.Characters.First.Information(wdActiveEndAdjustedPageNumber)
    j = .Cells(.Cells.Count).Range.Characters.Last.Information(wdActiveEndAdjustedPageNumber)
    ReDim Data(3, j - i)
    For p = i To j
      Set Rng = Doc.Range.GoTo(What:=wdGoToPage, Name:=p)
      Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
      r = Rng.Cells(1).RowIndex
      x = p - i: Data(1, x) = x: Data(2, x) = p: Data(3, x) = r
    Next
  End With
End With
End Sub

VBA - 优化Word每页第一行的定位索引Table via。 Excel

VBA - Optimizing locating index of first row on each page of Word Table via. Excel

excel

ms-word