Hallo Elex, hallo zusammen,
Zitat:beim Ersetzen solltest du dann noch etwas beachten. Siehe Anhang.
Klein/Groß wird berücksichtigt wenn MatchCase:=True.
davon bin ich nicht wirklich begeistert, außerdem geht das an der Sache vorbei.
Rückwärts wird gar nicht benötigt. (ich bin nun schlauer als beim Erstellen von #1)
Rückwärts ist Aufgabe des Übersetzers, der hat dafür Tools und will natürlich auch Geld dafür haben.
So sind die Preise unterschiedlich, ob ein Wort neu übersetzt werden muss oder ob es Wiederholungen sind.
Wir haben uns so beholfen:
1. Setze in Spalte B einen Index bis ganz unten.
2. Sortiere Spalte A Aufsteigend. Dadurch kann man mit dem Auge Blöcke erkennen, die nicht übersetzt werden müssen, und diese löschen.
Übrig bleiben die Zeilen mit zu übersetzenden Texten, Wenn man die Spalten A:B wieder nach B aufsteigend sortiert, sind die zu übersetzenden Zeilen wieder am richtigen Platz.
Der Zeitaufwand, die Blöcke zu löschen, ist aufwendig. Bei fast 90.000 Zeilen vergeht da ein Tag wie im Flug.
###
Darum habe ich überlegt, wie man das vereinfachen kann, und aus den Vorschlägen von den Forenbeantwortern mir was zusammengestrickt.
Das Tool macht folgendes:
Nachdem die nicht benötigten Zeichen in der Zelle entfernt wurden, bleiben Buchstabenkombis übrig, die Wörter sein können.
Wenn diese mehr als 2 Zeichen lang sind*), wird der User gefragt, ob das Wort zu übersetzen ist, oder nicht.
Sowohl die ja-Antworten als auch die nein-Antworten wandern in je eine Collection
Bei der nächsten Zeile wird zuerst geschaut, ob das gefundene Wort schon in den beiden Collections enthalten ist.
Wenn ja, ist bereits klar, was damit zu tun ist, wenn nein, User fragen.
Mit dieser Datei habe ich mal 336 Wörter zum Übersetzen gefunden und 216, die nicht übersetzt werden sollen.
In den Zeilen, in denen kein ja-Wort enthalten ist, wird in Spalte C ein x gesetzt.
Spalten A:C nach C sortiert, sind alle X oben und können auf einmal gelöscht werden.
Wörterliste 'Richtig' wird nach Spalte E, Wörterliste 'Falsch' wird nach Spalte F geschrieben.
So kann man nochmal kontrollieren, im Fall dass man sich verklickt hat bei der User-Entscheidung.
Und ggf. Änderungen durchführen.
Die Laufzeit des Tools ist abhängig von der Schnelligkeit des Users-Klickens, aber bei knapp 600 Entscheidungen ist das deutlich kürzer, als ein Tag.
Und hier nun mein Code:
Code:
Option Explicit
Sub TradosVorb()
Dim Ar As Variant
Dim colWort As New Collection
Dim colFal As New Collection
Dim i As Long, Behalt As Boolean, Tx As Variant, k As Integer, N As Integer, M As Integer, Frage As Integer, j As Integer, Eintrag As Variant, Item As Variant
Dim jj As Integer
Ar = ActiveSheet.UsedRange.Columns(1) ' Spalte A
For i = 2 To UBound(Ar)
If Len(Cells(i, 1)) < 200 And Cells(i, 1) <> "" Then
Behalt = False
Tx = Cells(i, 1)
' Zeichen durch Leerzeichen ersetzen
For jj = 1 To 17
Tx = Replace(Tx, Mid("0123456789+,='/-", jj, 1), " ")
If jj < 4 Then Tx = Replace(Tx, Chr(Choose(jj, 9, 10, 34)), " ")
Next
Tx = Split(Application.Trim(Tx))
For k = 0 To UBound(Tx)
If Len(Tx(k)) > 2 Then
' Texte in Großbuchstaben ignorieren
If Tx(k) <> UCase(Tx(k)) Then
Cells(i, 1).Select
On Error Resume Next
N = 0
' in ColFal werden die Worte gesammelt, die nicht übersetzt werden müssen, Jeder Tx(k)-Wert wird abgefragt, ob er schon drinsteht
For Each Eintrag In colFal
If Eintrag = Tx(k) Then N = 100: Exit For
Next
M = 0
' in ColWort werden die Worte gesammelt, die übersetzt werden müssen, Jeder Tx(k)-Wert wird abgefragt, ob er schon drinsteht
' Wenn ja, wird Behalt auf true gesetzt
For Each Eintrag In colWort
If Eintrag = Tx(k) Then M = 100: Behalt = True: Exit For
Next
' ist Tx(k) schon in einer Liste enthalten, ist nichts zu tun
If Behalt = True Then Exit For
' ist tx(k) in keiner Liste enthalten, dann muss er jetzt rein, User entscheidet
If N <> 100 And M <> 100 Then
Frage = MsgBox(Tx(k), vbYesNo, "= gut ? Zeile = " & i)
If Frage = 7 Then
colFal.Add Item:=Tx(k)
ElseIf Frage = 6 Then
colWort.Add Item:=Tx(k)
Behalt = 1
End If
On Error GoTo 0
End If
End If
End If
Next k
' Wenn Behalt Wahr ist, muss das x aus Spalte C raus, wenn Falsch - rein
If Behalt = True Then
Cells(i, 3) = ""
Else
Cells(i, 3) = "x"
End If
End If
Next i
' Richtig-Liste wird erstellt
ReDim arr(1 To colWort.Count)
For Each Item In colWort
j = j + 1
arr(j) = colWort(j)
Next
[E1].Select
Columns(5).Clear
Columns(6).Clear
Range("E1") = "Richtig"
Range("E2").Resize(colWort.Count, 1) = Application.Transpose(arr)
Columns("E:E").RemoveDuplicates Columns:=1, Header:=xlYes
Range("E2:E" & colWort.Count).Sort Key1:=Range("E1"), Order1:=xlAscending
' Falsch-Liste wird erstellt
j = 0
ReDim arr(1 To colFal.Count)
For Each Item In colFal
j = j + 1
arr(j) = colFal(j)
Next
Range("F1") = "Falsch"
Range("F2").Resize(colFal.Count, 1) = Application.Transpose(arr)
Columns("F:F").RemoveDuplicates Columns:=1, Header:=xlYes
' Schön machen und Autofilter setzen erste 3 Spalten
Range("F2:F" & colFal.Count).Sort Key1:=Range("F1"), Order1:=xlAscending
Range("c1") = "C"
Range("A1:C1").AutoFilter
' Sortieren nach C absteigend und A aufsteigend
Columns("A:C").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"C2:C" & UBound(Ar)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"A2:A" & UBound(Ar)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A1:C" & UBound(Ar))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
*)
Dabei gehen nun die Wörter mit 2 Buchstaben unter.
zu
in
im
an
…
Nach diesen lässt sich aber mit Strg+F > alle Suchen mit davor bzw dahintergesetzten Leerzeichen einfach fanden, und bei Fund, das x in C entfernen.
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
