使用Excel VBA从Word表格的单元格中删除内容

我目前正在进行一个项目，并寻求一些帮助。为了给你们一个正在发生的事情的布局，我将一步一步地浏览这个场景

1） 目前，我有一个名为“AnimalNamesToRemove”的字符串数组（本例中的数组包含以下单词），其中包含用作word文档书签的单词，我希望从下面引用的word表中删除这些单词：

AnimalNamesToRemove

AnimalCat、AnimalDog、AnimalBird

2） 除了数组之外，word文档中还有一个表，在第一列中有动物的名称，以及一些关于动物的信息（唯一重要的信息是动物的名称）：

单词表

3） 对于这个场景，我有一个excel表，我希望使用它来引用数组中的单词和单词表名称，因为在使用的word文档中已经有书签保存数组中存在的名称。为了将它们结合在一起，存在一个两列excel电子表格，其中包含书签名称和实际动物名称（第二列使用名为“myRangeRef”的范围引用）：

电子表格

4） 我想做的是，对于上述数组中的每个值，如果在电子表格（即第二列“书签引用”）中找到该值（例如“AnimalDog”），则在第一列（即“Dog”）中偏移到该值旁边的相应单元格，并使用这些值创建一个新的逗号分隔字符串，与“AnimalNamesToRemove”（即猫、狗、鸟），然后将其转换为一个名为“AnimalToDelete”的字符串数组。一旦创建了数组，并且在第一列中选择了所有值，并根据第二列中的引用将其转换为一个数组，我想在word表中逐行遍历，并针对新数组中存在的每个值“AnimalsToDelete”，如果该值（即Cat、Dog和Bird）存在于word表中（位于第一列），我希望代码删除该名称所在的整行（请参见下面显示的结果）

示例结果

如果您有任何解决方案和/或建议，请在下面进行评论

注意：代码的第一部分用于创建字符串数组（即从“set wdTable=”到“next i”），它是从word表中删除我遇到问题的信息。 最好的

---

Jack Henderson

好的，根据您的代码，我在我的Excel VBE（工具-引用，选中复选框）中添加了对Microsoft Word 16.0对象库的引用，因此我们有了可用的Word内容。 接下来，我编写了以下过程：

Sub Test()
Dim BookMarksToDelete() As String
Dim ReturnsToDelete() As String
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wdTable As Word.Table
Dim myRangeRef As Range
Dim cel As Range
Dim aCell As String

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Temp\Col1.docx")
Set wdTable = wDoc.Tables(1)

ReDim BookMarksToDelete(0 To 1)
    BookMarksToDelete(0) = "BlahOne"
    BookMarksToDelete(1) = "BlahThree"

Set myRangeRef = Worksheets("Sheet1").Range("B1:B5")

For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
    For Each cel In myRangeRef
        If InStr(1, cel.Value, BookMarksToDelete(i), vbTextCompare) Then
            aCell = cel.Offset(0, -1).Value
            stTemp = stTemp & "," & aCell
        End If
    Next cel
Next i

stTemp = Mid(stTemp, 2)
If Not Len(Trim(stTemp)) = 0 Then
    ReturnsToDelete = Split(stTemp, ",")
    For i = LBound(ReturnsToDelete) To UBound(ReturnsToDelete)
        For j = wdTable.Rows.Count To 2 Step -1
             If Left(wdTable.cell(j, 1).Range.Text, Len(wdTable.cell(j, 1).Range.Text) - 2) = ReturnsToDelete(i) Then
                wdTable.Rows(j).Delete
            End If
        Next j
    Next i
End If

wDoc.Save
wDoc.Close
wApp.Quit

Set wdTable = Nothing
Set wDoc = Nothing
Set wApp = Nothing
Set myRangeRef = Nothing
End Sub

正如你所看到的，我基本上坚持你完全相同的结构，它工作得非常完美

您的主要问题（word文档中的行未被删除或找到）是因为word表格中单元格中的文本实际上在末尾包含两个额外字符。一个是“假新行”，另一个在您点击word GUI上的此段落按钮时显示，这是一个“单元格结束”标记

例如，见

---

编辑我基于“BlahOne”和“NameOne”例如，但是是的，你可以为动物编辑它，当然…

你还可以包括输出应该是什么样子的图片吗？看起来很有趣而且可行。是的，当然，给我一分钟时间更新@vityatay当你所有的关键字都是泛型的或者只是“x”时，你的例子很难理解请看修改后的问题，希望这能使事情更清楚。非常感谢。最好，JackYou欢迎。如果它对你有用，请考虑接受这个答案。

Sub Test()
Dim BookMarksToDelete() As String
Dim ReturnsToDelete() As String
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wdTable As Word.Table
Dim myRangeRef As Range
Dim cel As Range
Dim aCell As String

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Temp\Col1.docx")
Set wdTable = wDoc.Tables(1)

ReDim BookMarksToDelete(0 To 1)
    BookMarksToDelete(0) = "BlahOne"
    BookMarksToDelete(1) = "BlahThree"

Set myRangeRef = Worksheets("Sheet1").Range("B1:B5")

For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
    For Each cel In myRangeRef
        If InStr(1, cel.Value, BookMarksToDelete(i), vbTextCompare) Then
            aCell = cel.Offset(0, -1).Value
            stTemp = stTemp & "," & aCell
        End If
    Next cel
Next i

stTemp = Mid(stTemp, 2)
If Not Len(Trim(stTemp)) = 0 Then
    ReturnsToDelete = Split(stTemp, ",")
    For i = LBound(ReturnsToDelete) To UBound(ReturnsToDelete)
        For j = wdTable.Rows.Count To 2 Step -1
             If Left(wdTable.cell(j, 1).Range.Text, Len(wdTable.cell(j, 1).Range.Text) - 2) = ReturnsToDelete(i) Then
                wdTable.Rows(j).Delete
            End If
        Next j
    Next i
End If

wDoc.Save
wDoc.Close
wApp.Quit

Set wdTable = Nothing
Set wDoc = Nothing
Set wApp = Nothing
Set myRangeRef = Nothing
End Sub