时间戳

首页 > 解决方案 > 如何快速识别Word中的空白表格列？

vba - 如何快速识别Word中的空白表格列？

问题描述

我在自动生成的 word 文档中有很多大表，我想删除其中没有值的列。它们都有标题，所以基本上我需要检查第 2 行的值到最后，或者只是在一个字符串中获取整个列并在我理解的第一个 chr(14) 之后检查是列标记。

这是否可能无需逐行循环单元格，这似乎很慢，或者选择似乎导致屏幕出现问题并且 UI 冻结的列，有时会导致 Word 崩溃。

标签： vbams-word

解决方案

你想做的事情是完全可能的，但可能会遇到问题。报告的选择范围内的单元格数量（以及要处理的文本）存在差异，具体取决于您是否使用

selection.cells

或者

selection.range.cells

前者按预期工作，后者没有。

下面的代码以您描述的方式删除列，还包括 debug.print 语句来演示问题。

我已经在 5x6 表上测试了代码。您的体验可能会有所不同。

Sub DeleteEmptyTableColumns(this_table As Word.Table)
    Dim my_cells                As Range
    Dim my_column               As Long
    Dim my_text                 As String
    Dim my_last_row             As Long

    ' Assumes that the Table is uniform
    my_last_row = this_table.Rows.Count
    Application.ScreenUpdating = False

    With this_table
        For my_column = .Columns.Count To 1 Step -1
            DoEvents
            Set my_cells = .Range.Document.Range( _
                Start:=.Cell(2, my_column).Range.Start, _
                End:=.Cell(my_last_row, my_column).Range.End)
            ' We have to use selection to get the correct text
            my_cells.Select

            Debug.Print
            ' Wrong numbers and text
            Debug.Print my_cells.Cells.Count
            Debug.Print my_cells.Text

            ' Correct information
            Debug.Print Selection.Cells.Count
            Debug.Print Selection.Text

            ' Back to the wrong information
            Debug.Print Selection.Range.Cells.Count
            Debug.Print Selection.Range.Text

            my_text = Selection.Text

            ' Add other replacments as required.
            my_text = Replace(my_text, " ", vbNullString)
            my_text = Replace(my_text, vbCrLf, vbNullString)
            my_text = Replace(my_text, Chr$(13), vbNullString)
            my_text = Replace(my_text, Chr$(7), vbNullString)

            If Len(my_text) = 0 Then
                this_table.Columns(my_column).Delete

            End If

        Next

    End With

    Application.ScreenUpdating = True

End Sub

推荐阅读