Word-VBA suchen/ersetzen

Dieses Thema Word-VBA suchen/ersetzen im Forum "Microsoft Office Suite" wurde erstellt von Ixus, 26. Apr. 2006.

Thema: Word-VBA suchen/ersetzen Hallo allerseits, vielleicht kann mir jemand helfen: Ein Text der durch dynamische Bausteine erstellt wurde, soll...

  1. Hallo allerseits,
    vielleicht kann mir jemand helfen:

    Ein Text der durch dynamische Bausteine erstellt wurde, soll auszugsweise einem Empfänger zur Verfügung gestellt werden. Alle Textbausteine die anschließend entfernt werden müssen, habe ich am Anfang bzw. Ende mit einem + Zeichen versehen. Das folgende Makro:

    Sub AutoNew()

    Selection.Paste

    Application.ScreenUpdating = True
    Application.ScreenUpdating = False
    With ActiveDocument.Range.Find
    .Format = True
    .MatchWildcards = True

    .Text = (+)(*)(+)
    .Replacement.Font.Name = Arial
    .Replacement.Font.Size = 11
    .Replacement.Font.Color = wdColorAutomatic
    .Replacement.Text = pp. ...
    .Execute Replace:=wdReplaceAll

    Application.ScreenUpdating = True
    End With

    End Sub


    kopiert mir den Originaltext in ein neues Dokument, sucht sich anschließend alle mit + markierten Stellen und ersetzt diese durch pp. .... Das funktioniert bis hierher auch ganz ordentlich. Mein Problem besteht darin, dass wenn mehrere zu entfernende Textteile im Originaltext gefunden werden, dann werden diese Teile auch mehrere Male durch pp. ... ersetzt. D.h. im Text steht dann mehrere Male hintereinander pp. ..., wo es aber nur 1x autauchen sollte.
    Hat jemand eine Lösung????

    Vielen Dank im voraus!!!

    Ixus
     
  2. Ola,

    setz noch eine Suchen und Ersetzen Schleife dran, die immer ppp. ... ppp. ... durch ein pp. ... ersetzt dann bleibt immer eines übrig, falls mehrere nacheinander stehen.
     
  3. Hallo,
    zunächst einmal Danke für Deine schnelle Antwort.
    Aber ich muss gestehen mir ist nicht klar, wie ich die Schleife setzen soll,
    denn wenn ich pp. ... durch pp. ... mittels einer Wildcard ersetze,
    dann bin ich doch schlussendlich genauso weit wie vorher oder irre ich
    mich jetzt?

    Irgendwie bräuchte ich eine Prüfroutine, die mir mehrere pp. ... im Text findet, markiert und durch 1x
    pp. ... ersetzt, aber wie ich so etwas zusammendrösele ist mir vollkommen unklar!
    Hattest Du so etwas gemeint????

    Liebe Grüße
    Ixus
     
  4. Nachtrag:
    Ach so, ich hatte vergessen zu erwähnen, dass die pp. ... auf mehrere Zeilen untereinander verteilt sind:
    Bsp.:

    Text

    pp. ...

    pp. ...

    Text


    pp. ...

    Text

    Gruß
    Ixus
     
  5. zweite Suchschleife

    Code:
    With ActiveDocument.Range.Find
        .Format = True
        .MatchWildcards = True
        
        .Text = pp. ...  & vbCrLf & vbCrLf & pp. ... 
        .Replacement.Font.Name = Arial
        .Replacement.Font.Size = 11
        .Replacement.Font.Color = wdColorAutomatic
        .Replacement.Text = pp. ... 
        .Execute Replace:=wdReplaceAll
      
      Application.ScreenUpdating = True
    End With
    Gruß Matjes :)
     
  6. Ola,

    nur der Vollständigkeit halber: Ja, so ähnlich. Wenn gleichartige Textobjekte merhfach hintereinander auftauchen und davom immer eines übrig bleiben soll, dann nimm immer zwei und ersetze durch eines. Wenn das nicht reicht,weil drei hintereinander auftauchen, dann passiert das eben zwei mal: 3 -> 2 -> 1
     
  7. :D Vielen, vielen, vielen Dank an Euch Beide!!!!!

    Das klappt ganz prima!!!!! :D

    Das war prompte und kompetente Hilfe!!!!

    Allerherzlichste Grüße
    Ixus
     
  8. und hier noch eine Sub  ;)

    Gruß Matjes :)
    Code:
    Sub Word_doppelteTexteErsetzen()
    '***
    '*** Der Suchtext wird im aktuellen Dokument gesucht.
    '***
    '*** Gibt es zwei Fundstellen, zwischen denen nur Steuer/Leerzeichen (ascii 0-32) vorhanden sind,
    '*** wird der Text vom Anfang der ersten Fundstelle bis zum Anfang der zweiten Fundstelle
    '*** gelöscht.
    
      Const c_SUCHTEXT = pp. ...
      
      Dim doc As Document, r As Range
      Dim FundSt1_start As Long, FundSt2_start As Long
      Dim s As String, b_Loeschen As Boolean, x As Long, l_asc As Long
      
      
      Set doc = ActiveDocument
      Set r = doc.Content
      
     ->1. Fundstelle
      With r.Find
        .ClearFormatting
        .Format = False
        .Forward = True
        .Text = c_SUCHTEXT
        If Not .Execute() Then GoTo AUFRAEUMEN-> nichts gefunden -> Ende
        FundSt1_start = .Parent.Start
      End With
    
     ->für alle c_Suchtext
      Do
        Set r = doc.Range(Start:=FundSt1_start + Len(c_SUCHTEXT), End:=doc.Content.End)
      
       ->2. Fundstelle
        With r.Find
          .ClearFormatting
          .Format = False
          .Forward = True
          .Text = c_SUCHTEXT
          If Not .Execute() Then GoTo AUFRAEUMEN-> nichts gefunden -> Ende
          FundSt2_start = .Parent.Start
        End With
      
        
        b_Loeschen = True
        Set r = doc.Range(Start:=FundSt1_start, End:=FundSt2_start)
        For x = 1 To r.Characters.Count
          If x > Len(c_SUCHTEXT) Then
            l_asc = Asc(r.Characters(x))
            Select Case l_asc
              Case 1 To 32:
              Case Else:
               b_Loeschen = False: Exit For
            End Select
          End If
        Next
        
        r.Select
        If b_Loeschen Then
         ->Text loeschen von Anf 1. Fundst bis Anf 2. Fundstelle
          r.Text = 
        Else
         ->zweite Fundstelle wird erste
          FundSt1_start = FundSt2_start
        End If
      
      Loop
    AUFRAEUMEN:
      Set r = Nothing: Set doc = Nothing
    End Sub
     
  9. Hallo Matjes,

    das ist ja suuper, so wie es aussieht sind alle meine Probleme für
    das Textprodukt mit Deiner letzten SUB gelöst!!

    ***Dir mal ein Bierchen->rüber reich! - Lass Dirs schmecken!!***

    Dankefein!!!
    Ixus