Word VBA: 如何编写宏来更改所选单元格，并创建表的汇总表？

Question

我有一些表格在文档中，大致看起来像这样：

| Thing     |   Title   |
|-----------|:---------:|
| Info      | A, B, C.  |
| Score     | Foo       |
| More Info | Long Text |
| Proof     | Blah      |

Figure 1
<Screenshot of Proof>

我希望它看起来像这样（左上角的数字）：

| Thing #1  |       Title       |
|-----------|:-----------------:|
| Info      | A, B, C.          |
| Score     | Foo               |
| More Info | Long Text         |
| Proof     | Blah <Screenshot> |

但是，文档中有许多表格，我只想使用“在选择范围内”的表格。

简而言之：我必须取出选择范围内的所有表格，并按顺序进行编号。我还希望制作一个如下所示的表格：

| Number | Title | Score | Number of CSV's in Info |
|--------|:-----:|-------|-------------------------|
| 1      | Thing | Foo   | 3                       |
| ...    | ...   | ...   | ...                     |
| ...    | ...   | ...   | ...                     |
| ...    | ...   | ...   | ...                     |    

这是我目前的翻译:

表格编号:

Sub NumberTablesSelection()
    Dim t As Integer

    Dim myRange as Range
    Set myRange = Selection.Range

    With myRange
        For t = 1 To .Tables.Count
            Set myCell = .Tables(t).Cell(1,1).Range
            myCell.Text = "Thing #" + t
            Next t
        End With
End Sub

表格列表（包含信息）：

Sub TableOfThings()
    Dim t As Integer

    Dim myRange as Range
    Set myRange = Selection.Range

    myTable = Tables.Add(Range:=tableLocation, NumRows:=1, NumColumns:=4)
    myTable.Cell(1,1).Range.Text = "Number"
    myTable.Cell(1,2).Range.Text = "Title"
    myTable.Cell(1,3).Range.Text = "Score"
    myTable.Cell(1,4).Range.Text = "Instances"

    With myRange
        For t = 1 To .Tables.Count

            Set Title = .Tables(t).Cell(1,2).Range 
            Set Instances = .Tables(t).Cell(2,2).Range
            Set Score = .Tables(t).Cell(3,2).Range

            Set NewRow = myTable.Rows.Add
            NewRow.Cells(1).Range.Text = t
            NewRow.Cells(2).Range.Text = Title
            NewRow.Cells(3).Range.Text = Score
            NewRow.Cells(4).Range.Text = Instances
        End With
End Sub

但它们根本不能按照我想要的方式工作，我似乎无法使它们正常运行。

有人可以为我提供解决方案吗？

- NictraSavios

---

请告诉我是否需要任何额外的信息或细节，我尝试提供一个最小可行的示例，然后是我目前拥有的最简单形式的代码。 - NictraSavios

在VBA中，字符串加数字，例如myCell.Text = "Thing #" + t，会尝试将字符串转换为数字，然后进行数字加法运算。因此，"Thing #" + t会导致“类型不匹配”的错误。应该使用连接符号“&”来代替：myCell.Text = "Thing #" & t。 - rskar

我同意rskar的观点，并且认为这些代码行可能也略有偏差：Set myCell = .Tables(t).Cell(1,1).Range myCell.Text = "Thing #" + t正确的应该是：Set myCell = .Tables(t).Cell(1,1) myCell.Range.Text = "Thing #" & t同时，myCell也应该被声明为一个范围。 - J. Garth

我该如何让表格的表格仅在我的光标下方的那些表格上工作，并将表格插入到我的光标处？（我尝试过谷歌搜索，但没有找到太多信息。我怀疑我在问题中使用的语言不正确） - NictraSavios

dim tbl as Table: for each tbl in myRange.Tables: 'do stuff with the table: Next tbl。或者类似这样的？ - J. Garth

Answer 1

我们需要考虑以下几个方面，以使宏能够按预期运行：

• 不能使用按钮或其他对象来调用宏，因为那会有效地改变选定内容。相反，可以通过 Alt + F8 或分配给宏的快捷键运行它。
• 选择必须是连续的。因此，如果有4个表格，则只选择表格#1和3将不起作用。应该选择从表格#1到#3。

有了这些和一些微小的调整，下面呈现的修改后的代码应该能够正常工作。

Option Explicit
Sub NumberTablesSelection()
    Dim t As Integer, myRange, myCell As Range
    Set myRange = Selection.Range
    With myRange
        For t = 1 To .Tables.Count
            Set myCell = .Tables(t).Cell(1, 1).Range
            myCell.Text = "Thing #" & t
        Next t
    End With
End Sub
Sub TableOfThings()
    Dim t As Integer, myRange As Range, myTable As Table, NewRow As Row, Title As String, Instances As Integer, Score As String
    Set myRange = Selection.Range
    Selection.EndKey Unit:=wdStory
    Set myTable = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=4)
    With myTable
        .Style = "Table Grid"
        .Rows(1).Shading.BackgroundPatternColor = -603917569
        .Cell(1, 1).Range.Text = "Number"
        .Cell(1, 2).Range.Text = "Title"
        .Cell(1, 3).Range.Text = "Score"
        .Cell(1, 4).Range.Text = "Instances"
    End With
    With myRange
        For t = 1 To .Tables.Count
            Title = .Tables(t).Cell(1, 2).Range
            Instances = UBound(Split(.Tables(t).Cell(2, 2).Range, ",")) + 1
            Score = .Tables(t).Cell(3, 2).Range
            Set NewRow = myTable.Rows.Add
            With NewRow
                .Shading.BackgroundPatternColor = wdColorAutomatic
                .Cells(1).Range.Text = t
                .Cells(2).Range.Text = txtClean(Title)
                .Cells(3).Range.Text = txtClean(Score)
                .Cells(4).Range.Text = Instances
            End With
        Next t
    End With
End Sub
Function txtClean(txt As String) As String
    txt = Replace(txt, Chr(7), "")
    txt = Replace(txt, Chr(13), "")
    txt = Replace(txt, Chr(11), "")
    txtClean = txt
End Function

编辑：列实例的结果已更改为“实例数”，而不是显示原始值。

- curious

---

我还没有完全弄清楚的是如何让分数成为表中值的数量，而不仅仅是这些值本身。 - NictraSavios

你能举个例子吗，比如表1和表2的分数是多少，以及在摘要中应该如何显示？ - curious

例子在问题中，是一个简单的CSV列表。如果单元格包含A、B、C，则可以在摘要中看到我有3个值。 - NictraSavios

我说错了，我指的是信息单元格，而不是分数。在代码中，我将其称为实例。 - NictraSavios

这可以通过Split函数实现。我已经相应地更新了代码。 - curious

Answer 2

这是基于评论的解决方案。仅基于阅读您的代码而没有进行测试，希望能够正常工作。如果需要进行微调，请随意编辑。

Sub NumberTablesSelection()
    Dim t As Integer

    Dim myRange as Range
    Set myRange = Selection.Range

    With myRange
        For t = 1 To .Tables.Count
            Set myCell = .Tables(t).Cell(1,1)
            myCell.Range.Text = "Thing #" & t
            Next t
        End With
End Sub

表格列表（包含信息）：

Sub TableOfThings()
    Dim t As Integer
    Dim tbl as Table
    Dim myRange as Range
    Set myRange = Selection.Range

    myTable = Tables.Add(Range:=tableLocation, NumRows:=1, NumColumns:=4)
    myTable.Cell(1,1).Range.Text = "Number"
    myTable.Cell(1,2).Range.Text = "Title"
    myTable.Cell(1,3).Range.Text = "Score"
    myTable.Cell(1,4).Range.Text = "Instances"

    t = 1
    For each tbl in myRange.Tables
        With tbl
            Set Title = .Cell(1,2).Range 
            Set Instances = .Cell(2,2).Range
            Set Score = .Cell(3,2).Range
        End With

       Set NewRow = myTable.Rows.Add
       With NewRow
           .Cells(1).Range.Text = t
           .Cells(2).Range.Text = Title
           .Cells(3).Range.Text = Score
           .Cells(4).Range.Text = Instances
      End With
      t = t + 1
    Next tbl

End Sub

- J. Garth