Tengo una tabla de palabras y tiene 2000 filas. Cada fila contiene alguna EXTENSIÓN, es decir, área de terreno en yardas cuadradas (yardas cuadradas) desde 10 pies cuadrados yardas a 70000 yardas cuadradas. Tengo que filtrarlo, necesito filas con una extensión superior a 500 Sq. Yds. Entre 2000 filas, quiero filtrar estas filas usando comodines en VBA Word Macro de tal manera que obtendré una Extensión de 500 y más, dejando filas por debajo de 500 Sq. yardas El texto que se encuentra es una combinación de caracteres y número. Quiero filtrar la búsqueda "EXTENT: ([5-9] [0-9] [0-9])". "EXTENT: XXXX" (dígitos del número).

Sub FilterExtentUsingWildcards()
  Application.ScreenUpdating = False
  Dim TblRng As Range, TmpRng As Range
  With ActiveDocument.Tables(1)
    Set TblRng = .Range: Set TmpRng = .Range
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "<EXTENT:><space>([3-9][0-9][0-9])" 'FindText which is combination of
        'characters, space and Number
        .MatchWildcards = True                'i.e. "EXTENT: XXXX(number digits)
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .Wrap = wdFindStop
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
      End With
      Do While .Find.Found
        If .InRange(TblRng) Then
          TmpRng.Collapse wdCollapseEnd
          TmpRng.FormattedText = .Rows(1).Range.FormattedText
          .Rows(1).Delete
        End If
        .Find.Execute
      Loop
    End With
    If .Rows.Count > TblRng.Rows.Count Then
      .Split .Rows(TblRng.Rows.Count + 1)
    End If
  End With
  Application.ScreenUpdating = True
End Sub
0
Sampath 30 ago. 2020 a las 09:05

1 respuesta

La mejor respuesta

El comentario en su código dice que está buscando "EXTENT: 300" y más, pero Find.Text no incluye el espacio. Luego enciende MatchWildcards y 7 líneas más tarde lo apaga.

He editado su código de la siguiente manera:

Sub FilterExtentUsingWildcards()
  Application.ScreenUpdating = False
  Dim TblRng As Range, TmpRng As Range
  With ActiveDocument.Tables(1)
    Set TblRng = .Range: Set TmpRng = .Range
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = "EXTENT: ([5-9][0-9][0-9])" 'FindText which is combination of characters, space and Number
        .MatchWildcards = True 'i.e. "EXTENT: XXXX(number digits)
        .Replacement.text = ""
        .Forward = True
        .Format = False
        .Wrap = wdFindStop
        .MatchCase = True
        .MatchWholeWord = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
      End With
      Do While .Find.Found
        If .InRange(TblRng) Then
          TmpRng.Collapse wdCollapseEnd
          TmpRng.FormattedText = .Rows(1).Range.FormattedText
          .Rows(1).Delete
        End If
        .Find.Execute
      Loop
    End With
    If .Rows.Count > TblRng.Rows.Count Then
      .Split .Rows(TblRng.Rows.Count + 1)
    End If
    'uncomment the next line if you want to delete the original table
    '.Delete
  End With
  Application.ScreenUpdating = True
End Sub

Antes: ingrese la descripción de la imagen aquí

Después: ingrese la descripción de la imagen aquí

0
Timothy Rylatt 30 ago. 2020 a las 11:30