Макрос, чтобы найти в таблице Word конкретную строку в ячейке и переместить ячейку х влево, отметьте цифру, затем установите типографику на ячейку «вниз» в том же столбце.

Question

У меня есть макрос ниже (измененная база для соответствия ожидаемому результату от Использование макроса для поиска в таблице в Word, чтобы найти определенную строку в ячейке, а затем установить типографику в другой ячейке в той же строке ).

У меня есть документ Word с таблицей переменных столбцов (первые 3 столбца смешанной ширины) и неизвестным количеством строк, и мне нужен макрос, который может искать строку «Среднее» в столбце 3. Текущий макрос предназначен для столбца Только 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