如何查找表格列，然后向下移动并替换单元格的内容，如果它是“N/A”

问题描述

我有将近 1,800 个 Word 文档，这些文档大约有 8 页，表格中有独特的数据。我们刚刚被告知，我们为其中一些表提供的数据不准确，需要从“N/A”更改为“0.0%”。由于文档中经常使用“N/A”，很遗憾我无法找到/替换该文本。

使用此线程 (Macro to find in Word table for specific string in a cell and move x cell left,check isnumeric then set typography on down x cell in the same column)，我能够调整下面的代码以找到列标题（按时完成率）并移动到相邻的单元格以更新它们。但是，由于此列用于百分比，因此 IsNumeric 代码正在更改它找到的由于百分比符号而导致的任何数据。

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

预先感谢您提供的任何帮助！

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,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

解决方法

试试这个：

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,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

,

如果要替换表中所有 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",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