Suchen/Ersetzen unterschiedlicher Formate

Dieses Thema Suchen/Ersetzen unterschiedlicher Formate im Forum "Microsoft Office Suite" wurde erstellt von ratlos222, 2. Juni 2005.

Thema: Suchen/Ersetzen unterschiedlicher Formate Hallo, als Nutzer von Word 2003 stellt sich mir folgendes Problem: Ich habe ein umfangreiches Word-Dokument...

  1. Hallo,

    als Nutzer von Word 2003 stellt sich mir folgendes Problem:

    Ich habe ein umfangreiches Word-Dokument erstellt, das u. a. (Autoren-)Namen in Kapitälchen enthält, denen eine Jahresangabe folgt (also z. B. MAIER 1993 oder MAIER (1993)). Diese ist allerdings nicht in Kapitälchen formatiert.

    Ich würde nun gerne alle Namen (in Kapitälchen) nebst Jahreszahlen im betreffenden Dokument suchen, gleichzeitig markieren, kopieren und in ein neues Dokument einfügen.

    Bislang ist mir dies nur für die Namen gelungen, nicht jedoch für Namen und den nachfolgenden Jahreszahlen. Wie muß ich vorgehen - ist mein Anliegen überhaupt umsetzbar (, da ich ja gleichzeitig nach zwei unterschiedlichen Formateinstellungen suchen muß)?

    Über Hilfe würde ich mich sehr freuen, weil mir damit sehr viel Arbeit abgenommen würde!

    Viele Grüße
    ratlos
     
  2. Hallo ratlos,

    mal schauen, ob sich das in Software giessen läßt.

    Wenn ich das richtig verstanden habe, sind nur die Namen als Kapitälchen formatiert.
    Umkehrschluß: alle mit Kapitälchen formatierten Stellen sind Namen und sollen gesucht werden.

    Es können folgende Zeichen folgen:
    1 bis 9 ( )

    Es ist eine Jahreszahl, wenn
    4 stellig
    4 stellig in Klammern
    (Leerstellen werden einfach nicht mitbetrachtet)

    Wenn eine Jareszahl festgestellt wird, wie soll sie dann im neuen Dokument hinter dem Namen auftauchen ?

    Name (1999)
    Name, 1999
    so wie sie im Ausgangsdokument steht

    Soll das ganze in eine Tabelle geschriebne werden ?


    Sind die Annahmen richtig ?

    Gruß Matjes  :)
     
  3. Hallo ratlos222,

    ein erster Wurf ;D Mit den obigen Annahmen könnte der Makro wie folgt aussehen.

    Gruß Matjes :)

    Code:
    Option Explicit
    
    Type myNameJahreszahl_structure
      s_Name As String
      s_Jahreszahl As String
    End Type
    
    '**********************************************************
    Sub NamenFormatKapitaelchenSuchenUndAufAnhaengendeJahreszahlUntersuchen()
     ->Voraussetzungen:
     -> die Namen sind als Kapitälchen formatiert
     -> es gibt keinen anderweitigen Text mit Formatierung Kapitälchen
     ->*****
     -> anhängende Jahreszahlen
     -> zul. Zeichen:  0 bis 9 ( )
     -> die den Namen folgenden Zeichen werden auf eine Form untersucht
     -> 1999
     -> (1999)
     -> Leerstellen werden dabei nicht mitbetrachtet
     ->****
     -> die gefundenen Namen und wenn vorhanden die folgende Jahreszahl
     -> werden in einem neuen Dokument alphabetisch geordnet ausgegeben
     ->****
      Const c_LENMAX_TEXTJAHRESZAHL = 10
      Dim doc As Document
      Dim l_StartName_anf As Long, l_StartName_end As Long
      Dim l_StartSave_anf As Long, l_StartSave_end As Long
      Dim l_PosEnd As Long, l_pos As Long
      Dim f_NJ() As myNameJahreszahl_structure, f_NJ_cnt As Long
      Dim s_tmp As String
        
      
     ->Feld Name,Jahreszahl initialisieren
      ReDim f_NJ(1 To 1): f_NJ_cnt = 0
      
      Set doc = ActiveDocument
      
     ->Suchbereichsende setzen
      l_PosEnd = doc.Content.End
      
      Do
       ->Kapitälchen suchen, vom Ende rückwärts
        Selection.Start = doc.Content.Start
        Selection.End = l_PosEnd
        With Selection.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Format = True
          .Forward = False
          .Wrap = wdFindStop
          .Text = ^?
          .Font.SmallCaps = True
          If .Execute() = False Then Exit Do->nichts gefunden ?
        End With
        
       ->Position merken
        l_StartName_anf = Selection.Start
        l_StartName_end = Selection.End
        
       ->Zeichen davor auch Kapitälchen ?
        l_pos = l_StartName_anf - 1
        
        Do
          If l_pos < 0 Then Exit Do->alles erledigt ?
          If doc.Range(Start:=l_pos, _
                        End:=l_pos + 1).Font.SmallCaps = False Then Exit Do
         ->Start-Position erweitern
          l_StartName_anf = l_pos
          l_pos = l_pos - 1
        Loop
        Selection.Start = l_StartName_anf
       ->Feld Name,Jahreszahl um einen Eintrag vergrößern
        f_NJ_cnt = f_NJ_cnt + 1: ReDim Preserve f_NJ(1 To f_NJ_cnt)
        doc.Range(Start:=l_StartName_anf, End:=l_StartName_end).Select
        f_NJ(f_NJ_cnt).s_Name = Trim(doc.Range(Start:=l_StartName_anf, End:=l_StartName_end).Text)
        
       ->anschließenden Text auf Jahreszahl untersuchen
        Selection.Start = l_StartName_end
        Selection.End = l_StartName_end + c_LENMAX_TEXTJAHRESZAHL
        s_tmp = Selection.Text
        
        f_NJ(f_NJ_cnt).s_Jahreszahl = _
          NachfolgendenTextAufJahreszahlUntersuchen(s_tmp)
        
       ->Suchbereichsende vor Namen setzen
        l_PosEnd = l_StartName_anf - 1
      
      Loop While l_PosEnd > 0
      
      Selection.Collapse
    
      
      If f_NJ_cnt = 0 Then
        MsgBox (Nichts gefunden.)
      Else
        Call NamenSortieren(f_NJ(), f_NJ_cnt)
        Call NahmeJahrInNeuemDocAusgeben(f_NJ(), f_NJ_cnt)
      End If
      
    Aufraeumen:
      Set doc = Nothing
    End Sub
    '**********************************************************
    Private Function NahmeJahrInNeuemDocAusgeben( _
                      f_NJ() As myNameJahreszahl_structure, f_NJ_cnt As Long)
      Dim newdoc As Document, x As Long
      
      Set newdoc = Documents.Add
      
      For x = 1 To f_NJ_cnt
        If f_NJ(x).s_Jahreszahl =  Then
          Selection.InsertAfter f_NJ(x).s_Name & vbCrLf
        Else
          Selection.InsertAfter f_NJ(x).s_Name &  ( & _
                                f_NJ(x).s_Jahreszahl & ) & vbLf
        End If
      Next
                      
      Set newdoc = Nothing
    End Function
    '**********************************************************
    Private Function NamenSortieren( _
                      f_NJ() As myNameJahreszahl_structure, f_NJ_cnt As Long)
     ->sortiert das Feld nach Namen
      Dim s_tmp As myNameJahreszahl_structure, x As Long, y As Long
      
      For x = 1 To f_NJ_cnt - 1
        For y = x + 1 To f_NJ_cnt
          If String1GroesserString2(f_NJ(x).s_Name, f_NJ(y).s_Name) Then
            s_tmp = f_NJ(x)
            f_NJ(x) = f_NJ(y)
            f_NJ(y) = s_tmp
          End If
        Next
      Next
    End Function
    '**********************************************************
    Private Function String1GroesserString2(s1 As String, s2 As String) As Boolean
     ->Groß/Kleinschreibung wird nicht berücksichtigt
    
      If s1 =  Then String1GroesserString2 = False
      If s2 =  Then String1GroesserString2 = True
      If Len(s1) > Len(s2) Then
        If LCase(Left(s1, Len(s2))) > LCase(Left(s2, Len(s2))) Then
          String1GroesserString2 = True
        Else
          String1GroesserString2 = False
        End If
      Else
        If LCase(Left(s1, Len(s1))) > LCase(Left(s2, Len(s1))) Then
          String1GroesserString2 = True
        Else
          String1GroesserString2 = False
        End If
      End If
    End Function
    '**********************************************************
    Private Function NachfolgendenTextAufJahreszahlUntersuchen( _
                                        s_tmp As String) As String
     ->gibt die ggf. enthaltene Jahreszahl zurück
      
      Dim s As String, x As Long
      Dim l_KlammerAuf As Long, l_AnzZahl As Long
      
      NachfolgendenTextAufJahreszahlUntersuchen = 
      s_tmp = Trim(s_tmp)
      If Len(s_tmp) = 0 Then Exit Function
      
     ->zeicheweise untersuchen
      l_KlammerAuf = 0
      l_AnzZahl = 0
      For x = 1 To Len(s_tmp)
        s = Mid(s_tmp, x, 1)
        Select Case s
          Case (
            l_KlammerAuf = l_KlammerAuf + 1
            If l_KlammerAuf > 1 Then Exit Function
          Case 0 To 9
            l_AnzZahl = l_AnzZahl + 1
            If l_AnzZahl = 4 Then
              NachfolgendenTextAufJahreszahlUntersuchen = _
                Mid(s_tmp, x - l_AnzZahl + 1, l_AnzZahl)
              Exit Function
            End If
          Case  
            If l_AnzZahl > 0 Then Exit Function
          Case Else
            Exit Function
        End Select
      Next x
    End Function
     
Die Seite wird geladen...

Suchen/Ersetzen unterschiedlicher Formate - Ähnliche Themen

Forum Datum
Excel - Werte unterschiedlicher Tabellenblätter für Übersicht automatisch ziehen Microsoft Office Suite 22. Aug. 2010
Verschiedene Benutzer mit unterschiedlicher IP Windows XP Forum 6. Feb. 2005
2 WLAN-Laptops mit unterschiedlicher Übertragungsrate - wie ändern??? Windows XP Forum 14. Aug. 2004
Termine mit unterschiedlicher Zeit (Import und Versand) Windows XP Forum 7. Juni 2004