Interne Daten können anonymisiert werden. Aber ich befürchte, dass die Datei mit so vielen Blättern einfach zu groß sein würde. Herber akzeptiert nur bis 300 kB
Sub Klexys_Musterdatei_Anonymisator()
' zu anonymisierende Zellen markieren und Makro laufen lassen
' !!! Zellen mit Formeln dürfen NICHT anonymisiert werden !!!
' !!! Zellen mit eindeutigen Schlüsselwerten (Matchcode) dürfen NICHT anonymisiert werden
' weil sie sonst alle gleich lauten und ihre Funktionalität einbüßen
' !!! Spaltenköpfe sollten im Sinne der Verständlichkeit NICHT anonymisiert werden
' die Zeichen werden durch andere Zeichen mit annähernd gleicher Breite (in Arial) ersetzt
' damit die Befüllung der Zellen möglichst identisch bleibt
' die Buchstaben L,J,I werden vorläufig nicht ersetzt, weil sie nicht durch genau gleich
' breite Buchstaben ersetzt werden können (kann unten aber aktiviert werden).
' die Ziffer 1 bleibt, weil sie oft eine besondere Bedeutung hat und
' auch nicht durch eine gleich breite Ziffer ersetzt werden kann
' die Ziffer 0 bleibt, weil sie oft eine besondere Bedeutung hat
' Ziffern
Selection.Replace What:="4", Replacement:="2", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="5", Replacement:="3", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="6", Replacement:="2", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="7", Replacement:="3", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="8", Replacement:="2", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="9", Replacement:="3", LookAt:=xlPart, MatchCase:=True
' Kleinbuchstaben
Selection.Replace What:="ä", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="d", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="e", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="f", Replacement:="t", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="g", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="h", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="j", Replacement:="i", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="k", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="l", Replacement:="i", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="n", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="o", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="ö", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="p", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="q", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="r", Replacement:="t", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="s", Replacement:="c", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="u", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="ü", Replacement:="b", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="v", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="w", Replacement:="m", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="x", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="y", Replacement:="a", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="z", Replacement:="c", LookAt:=xlPart, MatchCase:=True
' Großbuchstaben
Selection.Replace What:="A", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Ä", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="C", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="F", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="G", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="H", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="K", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="O", Replacement:="N", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Ö", Replacement:="N", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="P", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Q", Replacement:="N", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="R", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="S", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="T", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="U", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Ü", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="V", Replacement:="D", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="W", Replacement:="M", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="X", Replacement:="B", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Y", Replacement:="E", LookAt:=xlPart, MatchCase:=True
Selection.Replace What:="Z", Replacement:="E", LookAt:=xlPart, MatchCase:=True
'Selection.Replace What:="I", Replacement:="J", LookAt:=xlPart, MatchCase:=True
'Selection.Replace What:="L", Replacement:="J", LookAt:=xlPart, MatchCase:=True
End Sub