WORD 97 Makro: Wort-Dubletten beseitigen

Autor:
Jrgen Hinrichs
schul16@gmx.net
http://mitglied.lycos.de/erleuchtet/index-g.htm
Infos und Tips fr Word, Windows, Access, Excel, Internet

Dieses Makro unterliegt dem Urheberrecht und bleibt Eigentum des Autors.
Es ist Freeware und darf unter Nennung des Autors und der Herkunft
unentgeltlich weitergegeben werden.

Es darf weder verkauft noch verliehen noch anderweitig kommerziell
vertrieben werden, auch nicht in genderter oder erweiterter Form.

Jedwede Haftung wird ausgeschlossen.
Weitere Makros auf Anfrage.


###############

Makros Listen Bereinigen / Tabellen Bereinigen

"Dubletten3a"
Listen Bereinigen

Das Makro ordnet zusammengefgte, redundante Wortlisten aus Wrterbchern etc. und beseitigt Dubletten, auch kurze Stze. Auch aus Texten.	Fr Tabellen ist das Makro 


"Dubletten4a"
Tabellen Bereinigen

zustndig. 

Das Makro ordnet zusammengefgte, redundante Tabellen und beseitigt Dubletten. Jetzt auch mit kurzen Stzen, Tabelle wird allerdings zur Liste! 
 
Das Makro ist unausgereift und mu ggf. mehrfach ausgefhrt werden. 

Alles geschieht auf eigene Gefahr. Behandelte Dateien werden unwiderruflich verndert. Es gibt keine Garantie auf Datenintegritt. 

Wichtige Dateien deshalb grundstzlich bitte vorher sichern, am besten mehrfach. 

Es darf sich im Dokument jeweils nur eine Wortliste oder eine Tabelle befinden.

Die behandelte Liste mu, wenn gewnscht, manuell durch Tabellen - Text in Tabelle unter Angabe des Trennzeichens: Tabstops und Kontrolle der Spaltenzahl zurck in eine Tabelle verwandelt werden. Eine Automatik wre an dieser Stelle fehleranfllig. Ggf. vorher Bearbeiten - Alles Markieren.


NB:  Mit dem Makro "Dubletten4" (Alte Version) wird nur die erste Spalte einer Tabelle geprft und gelscht; der Zusammenhang bleibt erhalten. Aber nur jeweils  ein Wort! Zweimal ausgefhrt, sortiert es die Dubletten an den Anfang. hnliches gilt fr "Dubletten3".


###############


Den unten stehenden Makro- Code kopieren und in MS WORD 97
ber

 "Extras / Makro / Makros: Erstellen"

unter einem ausgewhlten Namen vollstndig in das sich ffnende Editor- Fenster einfgen.


Erstes Makro: 


CODE AB HIER KOPIEREN (inklusive der Anfangs- und Endzeilen mit "Sub / End Function") 

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Sub Dubletten3a()
Rem Makro erstellt 1999 von Juergen Hinrichs schul16@gmx.net

Dim Y

Rem Ordnet Wortlisten und beseitigt Dubletten - erweitert auf Absatz

WordBasic.MsgBox "Dieses Makro ordnet reine Listen und beseitigt Dubletten "


Rem CHECK

    Y = WordBasic.MsgBox("Letzte Warnung! Diese Datei wird jetzt Verndert! Weitermachen?", "Frage Weiter", 36)
    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo Fein
    

Rem MAKRO ABBRUCH
Rem Ende:
Rem Stop

Fein:
WordBasic.ViewNormal

WordBasic.StartOfDocument

WordBasic.WW7_EditGoTo Destination:="t"
If WordBasic.SelInfo(13) = -1 Then GoTo Weiter Else GoTo Halt

Halt:
WordBasic.MsgBox "Falsches Makro. ."
WordBasic.MsgBox "Im Dokument befindet sich eine Tabelle"
Exit Sub

Weiter:

WordBasic.StartOfDocument
WordBasic.InsertPara


Rem AUFSTEIGEND - Nicht gut, Bruchstcke am Anfang!

Rem TabelleSortieren .NichtberschrSortieren = 0, .SortSchlssel = "Abstze", .Art = 0, .Reihenfolge = 0, .SortSchlssel2 = "", .Art2 = 0, .Reihenfolge2 = 0, .SortSchlssel3 = "", .Art3 = 0, .Reihenfolge3 = 0, .Trennzeichen = 0, .SortSpalte = 0, .GroKlein =
' 1


Rem ABSTEIGEND

WordBasic.TableSort DontSortHdr:=0, FieldNum:="Abstze", Type:=0, Order:=1, FieldNum2:="", Type2:=0, Order2:=0, FieldNum3:="", Type3:=0, Order3:=0, Separator:=0, SortColumn:=0, CaseSensitive:=1


WordBasic.StartOfDocument

WordBasic.EditReplace Find:="^a^a^a^a^a^a", Replace:="^a", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a^a^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.EditReplace Find:="^a  ", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a ", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:=" ^a ", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

Rem ENDE VORBEREITUNG

Start:

Rem NUR BIS DOKUMENT ENDE Vorgehen
While WordBasic.CmpBookmarks("\Sel", "\EndOfDoc")

Rem MARKIEREN UND MERKEN

Rem BeginnZeile

WordBasic.EditFind Find:="^a", Direction:=1, MatchCase:=1, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0
WordBasic.ParaDown
Rem WortRechts 1, 1
Rem EndeZeile 1
WordBasic.ParaDown 1, 1
WordBasic.CharLeft 1, 1

WordBasic.EditFind Find:=WordBasic.[Selection$](), Direction:=0, MatchCase:=1, WholeWord:=1, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0

Rem ENDE PRFUNG

Rem BEDINGUNG PRFEN

If WordBasic.EditFindFound() <> 0 Then

Rem LSCHANWEISUNG, SPEZIFISCH
WordBasic.WW6_EditClear

WordBasic.ParaUp 2

WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceOne:=1, Format:=0, Wrap:=0

WordBasic.ParaUp

Rem WAS SONST; SPEZIFISCH; BEI LISTE ABSATZ
Else
WordBasic.ParaDown
End If

GoTo Start

Rem GEHRT ZU DOKUMENTENDE
Wend

WordBasic.StartOfDocument

WordBasic.TableSort DontSortHdr:=0, FieldNum:="Abstze", Type:=0, Order:=0, FieldNum2:="", Type2:=0, Order2:=0, FieldNum3:="", Type3:=0, Order3:=0, Separator:=0, SortColumn:=0, CaseSensitive:=1

WordBasic.StartOfDocument

WordBasic.EditReplace Find:="^a", Replace:="", Direction:=0, ReplaceOne:=1, Format:=0, Wrap:=0


Ende:
End Sub

Rem-----------------

Rem UNTERMAKRO

Private Function MarkPrf()
    If WordBasic.GetSelStartPos() = _
            WordBasic.GetSelEndPos() Then
        MarkPrf = 0
    Else
        MarkPrf = 1
    End If
End Function



+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


Zweites Makro:  


CODE AB HIER KOPIEREN (inklusive der Anfangs- und Endzeilen mit "Sub / End Function") 

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


Sub Dubletten4a()
Rem Makro erstellt 1999 von Juergen Hinrichs schul16@gmx.net


Dim Y

Rem Ordnet Tabellen und beseitigt Dubletten - erweitert auf Absatz

WordBasic.MsgBox "Dieses Makro ordnet reine Tabellen und beseitigt Dubletten "

WordBasic.MsgBox "Die Tabelle wird in eine Tabstop-getrennte Liste umgewandelt"

Rem CHECK

    Y = WordBasic.MsgBox("Letzte Warnung! Diese Datei wird jetzt Verndert! Weitermachen?", "Frage Weiter", 36)
    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo Fein
    

Rem MAKRO ABBRUCH
Rem Ende:
Rem Stop

Fein:
WordBasic.ViewNormal

WordBasic.StartOfDocument
WordBasic.InsertPara
WordBasic.InsertPara

WordBasic.WW7_EditGoTo Destination:="t1"

If WordBasic.SelInfo(13) = -1 Then GoTo Halt Else GoTo Weiter

Halt:
WordBasic.MsgBox "Falsches Makro. ."
WordBasic.MsgBox "Im Dokument befindet sich keine Tabelle"
Exit Sub

Weiter:
WordBasic.TableSelectTable


Rem AUFSTEIGEND - Nicht gut, Bruchstcke am Anfang!

Rem TabelleSortieren .NichtberschrSortieren = 0, .SortSchlssel = "Spalte1", .Art = 0, .Reihenfolge = 0, .SortSchlssel2 = "", .Art2 = 0, .Reihenfolge2 = 0, .SortSchlssel3 = "", .Art3 = 0, .Reihenfolge3 = 0, .Trennzeichen = 0, .SortSpalte = 0, .GroKlein =


Rem ABSTEIGEND

WordBasic.TableSort DontSortHdr:=0, FieldNum:="Spalte1", Type:=0, Order:=1, FieldNum2:="", Type2:=0, Order2:=0, FieldNum3:="", Type3:=0, Order3:=0, Separator:=0, SortColumn:=0, CaseSensitive:=1



WordBasic.EditReplace Find:="^t", Replace:="   ", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.TableSelectTable

WordBasic.TableToText ConvertTo:=1

WordBasic.StartOfDocument


WordBasic.StartOfDocument

WordBasic.EditReplace Find:="^a^a^a^a^a^a", Replace:="^a", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a^a^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.EditReplace Find:="^a  ", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a ", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:=" ^a ", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0
WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0


Rem ENDE VORBEREITUNG

Start:

Rem NUR BIS DOKUMENT ENDE Vorgehen
While WordBasic.CmpBookmarks("\Sel", "\EndOfDoc")

Rem MARKIEREN UND MERKEN

Rem BeginnZeile

WordBasic.EditFind Find:="^a", Direction:=1, MatchCase:=1, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0
WordBasic.ParaDown
Rem WortRechts 1, 1
Rem EndeZeile 1
WordBasic.ParaDown 1, 1
WordBasic.CharLeft 1, 1

WordBasic.EditFind Find:=WordBasic.[Selection$](), Direction:=0, MatchCase:=1, WholeWord:=1, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0

Rem ENDE PRFUNG

Rem BEDINGUNG PRFEN

If WordBasic.EditFindFound() <> 0 Then

Rem LSCHANWEISUNG, SPEZIFISCH
WordBasic.WW6_EditClear

WordBasic.ParaUp 2

WordBasic.EditReplace Find:="^a^a", Replace:="^a", Direction:=0, ReplaceOne:=1, Format:=0, Wrap:=0

WordBasic.ParaUp

Rem WAS SONST; SPEZIFISCH; BEI LISTE ABSATZ
Else
WordBasic.ParaDown
End If

GoTo Start

Rem GEHRT ZU DOKUMENTENDE
Wend

WordBasic.StartOfDocument

WordBasic.TableSort DontSortHdr:=0, FieldNum:="Abstze", Type:=0, Order:=0, FieldNum2:="", Type2:=0, Order2:=0, FieldNum3:="", Type3:=0, Order3:=0, Separator:=0, SortColumn:=0, CaseSensitive:=1

Rem GET RID OF - MUSS SO

WordBasic.StartOfDocument

WordBasic.EditReplace Find:="^a", Replace:="", Direction:=0, ReplaceOne:=1, Format:=0, Wrap:=1

WordBasic.EditReplace Find:="^a", Replace:="", Direction:=0, ReplaceOne:=1, Format:=0, Wrap:=1

WordBasic.InsertPara

WordBasic.EditSelectAll

WordBasic.MsgBox "Die Liste jetzt wenn gewnscht MANUELL durch 'Tabellen- Text in Tabelle' in eine Tabelle zurckverwandeln"

WordBasic.MsgBox "Trennzeichen: Tabstops"



Ende:
End Sub

Rem-----------------

Rem UNTERMAKRO

Private Function MarkPrf()
    If WordBasic.GetSelStartPos() = _
            WordBasic.GetSelEndPos() Then
        MarkPrf = 0
    Else
        MarkPrf = 1
    End If
End Function


+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++





Neue Makros in MS WORD 97 integrieren:

 "Extras / Anpassen / Befehle / Kategorien: Makros"

Makro auswhlen und durch Ziehen mit der Maus in ein Men einfgen oder ber "Tastatur" mit einer Tastenkombination belegen, 



Alternativ das Makro direkt ber

 "Extras / Makro / Ausfhren" 	

auswhlen und ausfhren lassen.




Einbau und Betrieb des Makros geschieht auf eigenes Risiko.

(c) 1999 Jrgen Hinrichs




