Texte zum Übersetzen finden

[Wastl]

Hallo snb,

wenn die 'activesheet' sich ändert, ändert auch das Ergebnis

soviel is mir auch klar.
Die Ergebnisse aus Beitrag #9 wurden alle am selben sheet ausprobiert.
Ausprobiert immer an Tabelle1 der im Beitrag #1 geposteten Datei.
Dort is der letzte Eintrag in Zelle A88815

Vorgehensweise
ich ändere die Zahl in der ersten Zeile und starte dann mit F8, bis er mir im Lokal-Fenster die Werte für die Variable sn anzeigt.
dann breche ich ab und geb den neuen Wert in die Klammer und teste erneut.

Aber warum is der bei 80.000 weniger als bei 40.000?
bzw. warum ist der Wert bei 40.000 höher als bei 100.000
Und genau das möchte ich bitte erklärt haben, Danke im Voraus

Wenn der Wert den einzulesenden Zeilen entspricht, müsste doch mit dem Wert in der Klammer auch der Wert der Variablen sn steigen.
An der Excelversion kanns nicht liegen, zuhause Excel 2013 (auf Arbeit 2010) bringt die selben Ergebnisse

PS: Die Arbeit is beendet, Danke an alle, hier gehts nur um meine Weiterbildung

[snb]

Transpose hat eine Obergrenze (ca. 2 ^ 16)

[Wastl]

Also kann ich transpose nicht verwenden bei 88815 Zeilen.
gibts dafür einen Ersatz oder muss ich mir was einfallen lassen, zB auf 2x, also meine Tabelle virtuell splitten?

[snb]

Gerade:

A1:A45000
A45001:A95000

[Wastl]

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.

[Elex]

Hi Wastl,
 

Aus der Überlegung heraus, wie die übersetzten Wörter am Ende wieder in die richtige Zelle kommen.

 
Ist die Stelle nicht egal.
 
Wörter in einer Liste zusammenfassen.
Übersetzung daneben.
Wort in Ganzer Spalte durch Übersetzung ersetzen.

Gruß Elex

[Wastl]

Wort in Ganzer Spalte durch Übersetzung ersetzen.

hi Elex
wie meinst du das?

Du beziehst dich aber schon auf Tabelle1 von meiner hochgeladenen Datei im ersten Beitrag?

[snb]

Code:

for jj=1 to 14
  Tx = Replace(Tx,mid("01234567890+.,=",j,1)
  if jj<4 then Tx=replace(Tx,chr(choose(j,9,10,34))," ")
next
sn=split(application.trim(tx))

NB. VBA.Trim <> application.Trim

[Elex]

Dachte so in etwa.


  Ersetzen.xlsm (Größe: 12,5 KB / Downloads: 3)

[Phi.VBA]

@Wastl

etwas spät, also nur als Übung.

Der Code findet 460 Begriffe:

Code:

Sub Wastl()
Dim DD As Object
Ar = ActiveSheet.UsedRange.Columns(1)
Set DD = CreateObject("Scripting.dictionary")
With CreateObject("vbscript.regexp")
   .Global = True
   .IgnoreCase = False
   .MultiLine = False
.Pattern = "[A-Za-zäöüÄÖÜ][a-zäöü]{2,}"
For i = 2 To UBound(Ar)
   If .test(Ar(i, 1)) Then y = DD(CStr(.Execute(Ar(i, 1))(0)))
Next i
Cells(1, 3).Resize(DD.Count + 1) = Application.Transpose(DD.keys)
End With
End Sub

Passt das, oder wid vieless übersehen?