如何使用vba查找和重新排列文本

发布于 2025-01-21 06:19:09 字数 16920 浏览 1 评论 0原文

我录制了一个宏,从.txt文件重新编码文本。好的,在那之后,我想做的是搜索一个关键字,它将在文本中找到一些单词,然后选择一个向上选择1个阵列(总是),这是我无法的棘手的部分在任何地方找到技巧,以及为什么我在这里,下面的选择各不相同,我不知道设定停止的方法。选择包含关键词的所有文本,然后将它们与文本结构一起在页面的末尾将其放在一起,或者能够复制所选文本以粘贴在其他文档中。

我正在使用宏之前和之后插入图像,以说明它的作用并帮助理解我的需求。如您所见,这张图片中的Kew单词是“ Hawk”和“ OPGW”,它们是用于建造电力传输线的电缆。上面的一条线是指“鹰”或“ opgw”电缆所在的开始和终端结构,而对于下面的这些关键字的行,它是指提交的张力负载等。线的变化。

我正在研究重塑.txt的Bellow代码。我不得不剪切我的代码中间部分,因为它是如此巨大,疯狂。.我们这里有5台计算机,所以我必须替换文本“ .text =” Cable'C:\ Users \ users \ xxxx ... “对于每个计算机访问的每个目录,这就是为什么如此大的哈哈。

我是Codding的新手,因此,如果可能的话,我希望您的指导。 在此先感谢您提供的任何帮助!

.txt文件中的文本

Sub VM_tabestic3()

Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, FindEndRange As Range
Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range


Set Find1stRange = ActiveDocument.Range
Set FindEndRange = ActiveDocument.Range
Set DelRange = ActiveDocument.Range


StartWord = "PLS-CADD Version"
EndWord = "Stringing Chart Report"


With Find1stRange.Find
    .Text = StartWord
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False


   Do While .Execute
    
    If .Found = True Then
        
        Set DelStartRange = Find1stRange
        
        DelStartRange.Select

     
        FindEndRange.Start = DelStartRange.End
        FindEndRange.End = ActiveDocument.Content.End

     
        FindEndRange.Select


   
        With FindEndRange.Find
            .Text = EndWord
            .Execute

       
            If .Found = True Then
               
                Set DelEndRange = FindEndRange

              
                DelEndRange.Select

            End If

        End With

     
        DelRange.Start = DelStartRange.Start
        DelRange.End = DelEndRange.End
      
        DelRange.Select

        
        DelRange.Delete



    End If
   Loop
  End With


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "Stringing Chart Report"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "Section #^?^?"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
    .Text = "from structure"
    .Replacement.Text = "Est. inicial"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
    .Text = " to structure"
    .Replacement.Text = " Est. final"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
    .Text = "Cable 'C:\Users\Usuario\ENGETRAN ENGENHARIA DE SISTEMAS DE TRANSMISSAO\Engetran - Documentos\Projetos\@Projeto Modelo\PLSCADD\Cabos Condutores\CA\1113_0-marigold.wir'"
    .Replacement.Text = "Cabo Condutor: CA MARIGOLD"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\starling_acsr.wir'"
    .Replacement.Text = "Cabo Condutor: CAA STARLING "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\T-caa_T-rail'"
    .Replacement.Text = "Cabo Condutor: T-CAA T-RAIL"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\tern_acsr.wir'"
    .Replacement.Text = "Cabo Condutor: CAA TERN"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\violet_aac - Cópia.wir'"
    .Replacement.Text = "Cabo Condutor: CA VIOLET"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\violet_aac.wir'"
    .Replacement.Text = "Cabo Condutor: CA VIOLET "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
    .Text = "Cable '\\brasil\g\publica\pls2\bibliote\cabos_2009\condutor\"
    .Replacement.Text = "Cabo Condutor: "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\publica\pls2\bibliote\cabos_2009\pararaio\"
    .Replacement.Text = "Cabo Para-raios: "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "Ruling span"
    .Replacement.Text = "Vão regulador"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Sagging data:  Catenary"
    .Replacement.Text = "Dados de flechamento: Catenária"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Condition I Temperature (deg C)"
    .Replacement.Text = "C. Inicial,  Temp. (°C)"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With

 Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Condition C Temperature (deg C)"
    .Replacement.Text = "C. Inicial,  Temp. (°C)"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Results below for condition 'Initial RS'"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = _
        "Calculations done using actual span lengths and vertical projections"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "  Span    Mid    Mid"
    .Replacement.Text = "          Mid    Mid"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Length"
    .Replacement.Text = "   Vão"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Results below for condition='I'"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Mid"
    .Replacement.Text = "    "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Span"
    .Replacement.Text = "    "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "  Sag "
    .Replacement.Text = "Flecha"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "           Left "
    .Replacement.Text = "  Suporte"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Vertical"
    .Replacement.Text = "        "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Projection"
    .Replacement.Text = "   Desnível"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Horiz"
    .Replacement.Text = "     "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Tension"
    .Replacement.Text = "Tração "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Struct"
    .Replacement.Text = "    Ré  "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Number"
    .Replacement.Text = "    N°  "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

ActiveDocument.Select
Selection.WholeStory
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8

ActiveDocument.Range.Find.Execute FindText:=" Est. inicial", ReplaceWith:="Est. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^m", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=",      .", ReplaceWith:=",", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="  (N)", ReplaceWith:=" (N)", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=",  Temp.", ReplaceWith:=", Temp.", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="  C. Inicial", ReplaceWith:=", C. Inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="start", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="  Est. f", ReplaceWith:=" - Est. f", Replace:=wdReplaceAll

Dim check As Boolean
 Dim search As String
Dim para As Paragraph
Dim tempStr As String
Dim txt As String

search = "set"

For Each para In ActiveDocument.Paragraphs
    txt = para.Range.Text
    tempStr = LCase(txt)
    check = InStr(tempStr, search)

    If check = True Then
        para.Range.Delete
    End If
Next


ActiveDocument.Range.Find.Execute FindText:="Est. i", ReplaceWith:="$ Est. i", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=", ^p", ReplaceWith:=", $ ^p", Replace:=wdReplaceAll

ActiveDocument.Range.Find.Execute FindText:="Section ^?^?", ReplaceWith:="", Replace:=wdReplaceAll

ActiveDocument.Range.Find.Execute FindText:=" Est. inicial", ReplaceWith:="Est. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="Est. inicial", ReplaceWith:="^pEst. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" Desnível", ReplaceWith:="Desnível", Replace:=wdReplaceAll

ActiveDocument.Range.Find.Execute FindText:="    (N)    (N)    (N)    (N)    (N)    (N)    (N)", ReplaceWith:="    (N)     (N)     (N)     (N)     (N)     (N)     (N) ", Replace:=wdReplaceAll

Set myRange = ActiveDocument.Content


Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
 .Text = "$*$"
 .MatchWildcards = True
 While .Execute
     oRng.Words.First.Delete


     oRng.Words.Last.Delete
    oRng.Bold = True
    oRng.InsertBefore ""
    oRng.InsertAfter ""
    oRng.Characters.Last.Bold = False
    oRng.Collapse wdCollapseEnd
       Wend
      End With
      lbl_Exit:
   Exit Sub


End Sub

i have recorded a macro where i remodel a text from .txt file. Ok, after that, what i want to do is to search for a key word, which will find some of this words in the text and then, to select 1 line upwards (always) and, this the tricky part where i couldn't find tips anywhere and why i'm here, the selection below varies and i dont know to set a way to stop. Select all the texts containing the key word and put them together, with the text structure, at end of the page or being able to copy those selected text to be able to paste in other document.

I'm inserting images before and after using the macro, to illustrate what it does and help understand what i need. As you can see, the kew words in this picture are "HAWK" and "OPGW", they are cables used to build electric power transmission lines. Where one line above refers to the start and end structure to which the "HAWK" or "OPGW" cable is attached to, and for the lines below these key words, it refers to the tension loads submitted and etc..., That's why the variation of lines.

I'm attatching bellow my code which remodels the .txt. I had to cut the middle part of my code, because it was so huge, insanely huge.. we have 5 computers here, so i had to replace the text ".Text = "Cable 'C:\users\XXXX..." for each directory accessed by each computer, that's why is so big haha.

I am a newbie at codding, so i would like your guidance if possible.
Thanks in advance for any help you may provide!

The text from .txt file

The text from .txt file after using the macro

Sub VM_tabestic3()

Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, FindEndRange As Range
Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range


Set Find1stRange = ActiveDocument.Range
Set FindEndRange = ActiveDocument.Range
Set DelRange = ActiveDocument.Range


StartWord = "PLS-CADD Version"
EndWord = "Stringing Chart Report"


With Find1stRange.Find
    .Text = StartWord
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False


   Do While .Execute
    
    If .Found = True Then
        
        Set DelStartRange = Find1stRange
        
        DelStartRange.Select

     
        FindEndRange.Start = DelStartRange.End
        FindEndRange.End = ActiveDocument.Content.End

     
        FindEndRange.Select


   
        With FindEndRange.Find
            .Text = EndWord
            .Execute

       
            If .Found = True Then
               
                Set DelEndRange = FindEndRange

              
                DelEndRange.Select

            End If

        End With

     
        DelRange.Start = DelStartRange.Start
        DelRange.End = DelEndRange.End
      
        DelRange.Select

        
        DelRange.Delete



    End If
   Loop
  End With


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "Stringing Chart Report"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "Section #^?^?"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
    .Text = "from structure"
    .Replacement.Text = "Est. inicial"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
    .Text = " to structure"
    .Replacement.Text = " Est. final"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
    .Text = "Cable 'C:\Users\Usuario\ENGETRAN ENGENHARIA DE SISTEMAS DE TRANSMISSAO\Engetran - Documentos\Projetos\@Projeto Modelo\PLSCADD\Cabos Condutores\CA\1113_0-marigold.wir'"
    .Replacement.Text = "Cabo Condutor: CA MARIGOLD"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\starling_acsr.wir'"
    .Replacement.Text = "Cabo Condutor: CAA STARLING "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\T-caa_T-rail'"
    .Replacement.Text = "Cabo Condutor: T-CAA T-RAIL"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\tern_acsr.wir'"
    .Replacement.Text = "Cabo Condutor: CAA TERN"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\violet_aac - Cópia.wir'"
    .Replacement.Text = "Cabo Condutor: CA VIOLET"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\PUBLICA\pls2\Bibliote\Cabos_2009\condutor\violet_aac.wir'"
    .Replacement.Text = "Cabo Condutor: CA VIOLET "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With


Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
    .Text = "Cable '\\brasil\g\publica\pls2\bibliote\cabos_2009\condutor\"
    .Replacement.Text = "Cabo Condutor: "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Cable '\\brasil\g\publica\pls2\bibliote\cabos_2009\pararaio\"
    .Replacement.Text = "Cabo Para-raios: "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "Ruling span"
    .Replacement.Text = "Vão regulador"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Sagging data:  Catenary"
    .Replacement.Text = "Dados de flechamento: Catenária"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Condition I Temperature (deg C)"
    .Replacement.Text = "C. Inicial,  Temp. (°C)"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With

 Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Condition C Temperature (deg C)"
    .Replacement.Text = "C. Inicial,  Temp. (°C)"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Results below for condition 'Initial RS'"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = _
        "Calculations done using actual span lengths and vertical projections"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "  Span    Mid    Mid"
    .Replacement.Text = "          Mid    Mid"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Length"
    .Replacement.Text = "   Vão"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Results below for condition='I'"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Mid"
    .Replacement.Text = "    "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Span"
    .Replacement.Text = "    "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "  Sag "
    .Replacement.Text = "Flecha"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "           Left "
    .Replacement.Text = "  Suporte"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Vertical"
    .Replacement.Text = "        "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Projection"
    .Replacement.Text = "   Desnível"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Horiz"
    .Replacement.Text = "     "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Tension"
    .Replacement.Text = "Tração "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Struct"
    .Replacement.Text = "    Ré  "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "Number"
    .Replacement.Text = "    N°  "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

ActiveDocument.Select
Selection.WholeStory
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8

ActiveDocument.Range.Find.Execute FindText:=" Est. inicial", ReplaceWith:="Est. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^m", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=",      .", ReplaceWith:=",", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="  (N)", ReplaceWith:=" (N)", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=",  Temp.", ReplaceWith:=", Temp.", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="  C. Inicial", ReplaceWith:=", C. Inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="start", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="  Est. f", ReplaceWith:=" - Est. f", Replace:=wdReplaceAll

Dim check As Boolean
 Dim search As String
Dim para As Paragraph
Dim tempStr As String
Dim txt As String

search = "set"

For Each para In ActiveDocument.Paragraphs
    txt = para.Range.Text
    tempStr = LCase(txt)
    check = InStr(tempStr, search)

    If check = True Then
        para.Range.Delete
    End If
Next


ActiveDocument.Range.Find.Execute FindText:="Est. i", ReplaceWith:="$ Est. i", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=", ^p", ReplaceWith:=", $ ^p", Replace:=wdReplaceAll

ActiveDocument.Range.Find.Execute FindText:="Section ^?^?", ReplaceWith:="", Replace:=wdReplaceAll

ActiveDocument.Range.Find.Execute FindText:=" Est. inicial", ReplaceWith:="Est. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="^p^p^p", ReplaceWith:="^p^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:="Est. inicial", ReplaceWith:="^pEst. inicial", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute FindText:=" Desnível", ReplaceWith:="Desnível", Replace:=wdReplaceAll

ActiveDocument.Range.Find.Execute FindText:="    (N)    (N)    (N)    (N)    (N)    (N)    (N)", ReplaceWith:="    (N)     (N)     (N)     (N)     (N)     (N)     (N) ", Replace:=wdReplaceAll

Set myRange = ActiveDocument.Content


Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
 .Text = "$*
quot;
 .MatchWildcards = True
 While .Execute
     oRng.Words.First.Delete


     oRng.Words.Last.Delete
    oRng.Bold = True
    oRng.InsertBefore ""
    oRng.InsertAfter ""
    oRng.Characters.Last.Bold = False
    oRng.Collapse wdCollapseEnd
       Wend
      End With
      lbl_Exit:
   Exit Sub


End Sub

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

月依秋水 2025-01-28 06:19:09

这不是答案。问答者已提出一个示例,说明如何实施我的建议。

当前,该代码是这样写的:

Sub Example()
    With Selection.Find
        .Text = "A"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    With Selection.Find
        .Text = "B"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    With Selection.Find
        .Text = "C"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

那是41行代码(不计数空白行),并将为每个新发现&添加13行代码。更换项目。

与其为每个项目重复此代码块,不如创建一个类似的子:

Sub CustomFindReplace(FindWithin As Object, FindText As String, Optional ReplaceText As String = "")
    With FindWithin.Find
        .Text = FindText
        .Replacement.Text = ReplaceText
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    FindWithin.Find.Execute Replace:=wdReplaceAll
End Sub

然后您的主要程序可以缩短:

Sub Example2()
    CustomFindReplace Selection, FindText:="A", ReplaceText:="X"
    CustomFindReplace Selection, FindText:="B", ReplaceText:="Y"
    CustomFindReplace Selection, FindText:="C", ReplaceText:="Z"
End Sub

现在,我们降至5行代码,而不是41行。每个新项目将添加一行代码。

This is not an answer. The Asker has requested an example of how to implement my suggestions.

Currently, the code is written like this:

Sub Example()
    With Selection.Find
        .Text = "A"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    With Selection.Find
        .Text = "B"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    With Selection.Find
        .Text = "C"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

That is 41 lines of code (not counting blank lines) and would take an additional 13 lines of code for each new Find & Replace item.

Instead of repeating this code block for each item, create a sub like this:

Sub CustomFindReplace(FindWithin As Object, FindText As String, Optional ReplaceText As String = "")
    With FindWithin.Find
        .Text = FindText
        .Replacement.Text = ReplaceText
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    FindWithin.Find.Execute Replace:=wdReplaceAll
End Sub

Then your main program can be shortened:

Sub Example2()
    CustomFindReplace Selection, FindText:="A", ReplaceText:="X"
    CustomFindReplace Selection, FindText:="B", ReplaceText:="Y"
    CustomFindReplace Selection, FindText:="C", ReplaceText:="Z"
End Sub

Now instead of 41 lines, we are down to 5 lines of code. Each new item will add one line of code.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文