Hi,
Thema ist zwar erledigt, aber ich war noch nicht zufrieden (privat)
Die Aufgabenstellung hat sich auch geändert:
Aus der Überlegung heraus, wie die übersetzten Worter am Ende wieder in die richtige Zelle kommen, wurde eine andere Vorgehensweise beschlossen.
- Wir nummerieren in Spalte B von 1 bis 88815
- wir sortieren dann nach Spalte A und können dann schneller, blockweise, die Texte rauslöschen, die keinen zu übersetzenden Text enthalten.
So wurden wir dann in etwa 1,5 Tagen damit fertig, obwohl noch immer etwa 60.000 Zeilen zu überprüfen waren und etwa 4500 übrig bleiben.
Aufgrund der Anregungen von Phil.VBA und snb hab ich aber das weitergestrickt und möchte es nun hier zeigen.
Vielleicht kann man das ja auch schöner (professioneller) machen.
Mein Code findet nun - mit der user-Entscheidung ob gut/falsch - ca. 343 gute Wörter und 211 falsche Wörter. Das entspricht in etwa der Vorarbeit.
Händisch:
Wenn du nun die Liste nach Spalte C Absteigend sortierst, kannste alle Texte in Spalte A, die in C ein x haben, löschen. Das Verbleibende sortierst du wieder nach Spalte B wo die Nummerierung steht.
Hier nun mein Code
Code:
Option Explicit
Sub TradosVorb()
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
For i = 2 To 100000
' Die Längenbegrenzung is wegen dem Fehler in der Tabelle in Zelle A46160, damit wird sie übersprungen
If Len(Cells(i, 1)) < 200 And Cells(i, 1) <> "" Then
Behalt = False
Tx = Cells(i, 1)
' Zeichen durch Leerzeichen ersetzen
Tx = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Tx, "0", " "), "1", " "), "2", " "), "3", " "), "4", " "), "5", " "), "6", " ")
Tx = Replace(Replace(Replace(Replace(Tx, "7", " "), "8", " "), "9", " "), "+", " ")
Tx = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Tx, vbLf, " "), Chr(9), " "), ",", " "), ".", "."), "'", " "), "/", " "), "-", " ")
Tx = Trim(Replace(Replace(Replace(Replace(Replace(Replace(Tx, "=", ""), Chr(34), " "), " ", " "), " ", " "), " ", " "), " ", " "))
Tx = Split(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 ?")
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
Range("F2:F" & colFal.Count).Sort Key1:=Range("F1"), Order1:=xlAscending
End Sub
Am Ende enthält nun die Liste nur noch zu übersetztende Einträge an der richtigen Stelle.
Nach dieser Vorarbeit kann man nun kalkulieren, wie hoch die Übersetzungskosten sind und ein Angebot erstellen.