在Word表中查找某个单元格中特定字符串的宏，然后向左移动x单元格，检查数字，然后在同一列中的向下x单元格上设置版式

Question

我下面有一个宏（已修改基数以适应Use macro to search table in Word to find specific string in a cell and then set typography on another cell in the same row的预期结果）。

我有一个Word文档，其中包含可变列（前3列混合宽度）和未知行数的表，并且我需要一个可以在第3列中搜索字符串“ Mean”的宏。仅6个。预计从第5列到最后一列。

如果找到完全匹配的宏，则将选择移至第6列（向左移动3个单元格）。检查字符串是否为严格数字（带数字，后跟*或**或***）。如果为数字，则选择移动3个单位并替换字符串“ -----”。

当前宏将所有字符串替换为“ -----”，甚至包含非数字字符串的字符串。

简而言之，搜索“均值”然后向左移动然后检查字符串是否为数字。如果为数字，则向下减小3单位并替换为“ -----”，否则保持不变。就像L形移动和替换一样。

我无法在字符串是否为数字之间进行检查，然后进行替换。我尝试包括regexp.Pattern = "^[0-9]+$"检查，但跳过了该代码。

当前宏仅用于第6列。预计从第5列到最后一列。

Sub FindMeanReplace()
    Dim oTbl As Table
    Dim stT As Long, enT As Long
    Dim stS As Long, enS As Long
    Dim regexp

    With Selection.Find             ' the settings remain until changed
        .Text = "Mean"
        .Replacement.Text = "Mean"
        .Forward = True
        .Wrap = wdFindContinue
    End With

    For Each oTbl In ActiveDocument.Tables

        oTbl.Columns.Select                        ' not sure if this is required

        Do While Selection.Find.Execute

            stT = oTbl.Range.Start                    ' table range
            enT = oTbl.Range.End

            stS = Selection.Range.Start               ' found text range
            enS = Selection.Range.End

            If stS < stT Or enS > enT Then Exit Do    ' text found inside table ???

            Selection.Collapse wdCollapseStart
            Selection.Find.Execute Replace:=wdReplaceOne

            Selection.MoveRight Unit:=wdCell
            Selection.MoveRight Unit:=wdCell
            Selection.MoveRight Unit:=wdCell

            'Set regexp = CreateObject("VBScript.Regexp")


            'regexp.Pattern = "[0-9]+$"  'not strictly return numbers
            'regexp.Pattern = "^[0-9]+$" 'strictly numeric


            Selection.MoveDown Unit:=wdLine, Count:=3

            Selection.Delete ' = "--"

            Selection.Text = "-----"

        Loop
        Selection.Collapse wdCollapseEnd
    Next
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 = "Mean"
    .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 IsNumeric(Split(.Cell(r, c + 1).Range.Text, vbCr)(0)) Then .Cell(r + 3, c + 1).Range.Text = "--"
        If IsNumeric(Split(.Cell(r, c + 2).Range.Text, vbCr)(0)) Then .Cell(r + 3, c + 2).Range.Text = "--"
        If IsNumeric(Split(.Cell(r, c + 3).Range.Text, vbCr)(0)) Then .Cell(r + 3, c + 3).Range.Text = "--"
        If IsNumeric(Split(.Cell(r, c + 4).Range.Text, vbCr)(0)) Then .Cell(r + 3, c + 4).Range.Text = "--"
      End With
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub