如何找到 table 列，然后向下移动并替换单元格的内容如果它是 "N/A"

Question

我有将近 1,800 个 Word 文档，其中大约 8 页具有 table 中的唯一数据。我们刚刚被告知，我们为其中一些 table 提供的数据不准确，需要从“N/A”更改为“0.0%”。由于“N/A”在文档中被大量使用，不幸的是我不能只find/replace那个文本。

使用此线程 () 我能够调整下面的代码以找到列 header（On-Time 完成率）并移动到相邻的单元格以更新它们.但是，由于此列用于百分比，因此 IsNumeric 代码正在更改它找到的任何数据，因为百分比符号。

有没有办法做同样的事情，而不是使用 IsNumeric（因为它不适用于百分比）检查单元格中的值，如果发现“N/A”，则更改它到“0.0%”？然后需要再重复两次 table，其中一个 table 有四行要查看。

提前感谢您提供的任何帮助！

Screenshot of table

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, c As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "On-time Completion Rate" 'Column Header'
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Information(wdWithInTable) = True Then
      r = .Cells(1).RowIndex
      c = .Cells(1).ColumnIndex
      With .Tables(1)
             If Not IsNumeric(Split(.Cell(r + 1, c).Range.Text, vbCr)(0)) Then .Cell(r + 1, c).Range.Text = "0.0%"
        If Not IsNumeric(Split(.Cell(r + 2, c).Range.Text, vbCr)(0)) Then .Cell(r + 2, c).Range.Text = "0.0%"
      End With
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

Answer 1

试试这个：

Sub Demo()
   Application.ScreenUpdating = False
   Dim r As Long, c As Long
   With ActiveDocument.Range
      With .Find
         .ClearFormatting
         .Replacement.ClearFormatting
         .Text = "On-time Completion Rate" 'Column Header'
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindStop
         .Format = False
         .MatchWildcards = True
         .Execute
      End With
      Do While .Find.Found
         If .Information(wdWithInTable) = True Then
            r = .Cells(1).RowIndex
            c = .Cells(1).ColumnIndex
            With .Tables(1)
               If Split(.Cell(r + 1, c).Range.Text, vbCr)(0) = "N/A" Then .Cell(r + 1, c).Range.Text = "0.0%"
               If Split(.Cell(r + 2, c).Range.Text, vbCr)(0) = "N/A" Then .Cell(r + 2, c).Range.Text = "0.0%"
            End With
         End If
         .Collapse wdCollapseEnd
         .Find.Execute
      Loop
   End With
   Application.ScreenUpdating = True
End Sub

Answer 2

如果要替换表中 N/A 的所有实例，以下方法会更有效：

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "On-time Completion Rate"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Duplicate.Tables(1).Range.Find.Execute FindText:="N/A", ReplaceWith:="0.0%", Wrap:=wdFindStop, Replace:=wdReplaceAll
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

扩展它以处理整个文档文件夹，您可以使用如下代码：

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = "On-time Completion Rate"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False
          .MatchWildcards = True
          .Execute
        End With
        Do While .Find.Found
          .Duplicate.Tables(1).Range.Find.Execute FindText:="N/A", ReplaceWith:="0.0%", Wrap:=wdFindStop, Replace:=wdReplaceAll
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

要进一步扩展代码以处理子文件夹中的文档，请参阅：https://www.msofficeforums.com/47785-post14.html

要将更新的文档另存为 PDF，请插入：

.SaveAs FileName:=Split(.FullName, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

之前：

.Close SaveChanges:=True

如何找到 table 列，然后向下移动并替换单元格的内容如果它是 "N/A"

How to find table column, then move down and replace the cell's content IF it is "N/A"

vba

ms-word

isnumeric

find-replace