Hallo blz,
Ich denke, dass es keinesfalls mehr als 500 werden!
(Aber spielt das eine Rolle fuer den Code? funktioniert das
nicht mit einer beliebigen Menge?)
die Menge spielt eine Rolle bei der Wahl des Codes aus
Schnelligkeitsgründen.
Ideal waere es, wenn das Programm die Datei parst und also in
der selben Datei einerseits die Englischen Bedeutungen eines
in Deutsch mehrfach vorkommenden Wortes mit Kommata
aneinanderreiht und andererseits, wenn ein Englisches Wort in
mehreren Zeilen vorkommt, dessen Deutsche Bedeutungen mit
Kommata aneinanderreiht.
Nachstehender Code erwartet ein Blatt mit Namen „Original“.
Heißt dein Blatt anders so ändere das im Code an dieser Stelle ab:
Set wksO = Worksheets(" Original")
Die deutschen Worte sollen in Spalte A sein, die engl. in B
Du startest den Code indem du im VB-Editor den Cursor irgendwo in den
Code von „Sub Start()“ stellst und F5 drückst.
Alternativ in Excel Alt+F8 drücken, dann das Makro Start ausführen
lassen.
Durh die Codezeilen
Call Zusammen(„DE“)
Call Zusammen(„EN“)
werden zwei Blätter erzeugt mit Namen „DE“ und „EN“.
Existierende Blätter mit diesen Namen werden im Verlauf des Codes
gelöscht.
Blatt „DE“ hat in A die dt. Wörter, in B die durch Komma getrennten
engl. Wörter.
Blatt „EN“ hat in A die engl. Wörter, in B die durch Komma getrennten
dt. Wörter.
Willst du den erzeugten Blättern andere Namen geben so mußt du diese
drei Codezeilen abändern:
Call Zusammen(" DE")
Call Zusammen(" EN")
If DE_EN = " DE" Then
Gruß
Reinhard
Option Explicit
Sub Start()
Call Zusammen("DE")
Call Zusammen("EN")
End Sub
Sub Zusammen(ByVal DE\_EN As String)
Dim wksO As Worksheet, Zei As Long, wks As Worksheet
Set wksO = Worksheets("Original")
For Each wks In Worksheets
If wks.Name = DE\_EN Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
Exit For
End If
Next wks
Worksheets.Add after:=Worksheets(Worksheets.Count)
With ActiveSheet
.Name = DE\_EN
If DE\_EN = "DE" Then
wksO.Range("A:B").Copy .Range("A1")
Else
wksO.Range("A:A").Copy .Range("B1")
wksO.Range("B:B").Copy .Range("A1")
End If
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:B" & Zei).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Range("D1:smiley:" & Zei).Formula = "=IF(A1=A2,"""",1)"
.Range("C1").Formula = "=B1"
.Range("C2:C" & Zei).Formula = "=IF(A1=A2,C1&"", ""&B2,B2)"
.Range("C1:smiley:" & Zei).Value = .Range("C1:smiley:" & Zei).Value
On Error Resume Next
.Range("D1:smiley:" & Zei).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Range("B:B,D:smiley:").Delete
' .Range("C:C").Copy .Range("A1")
' .Range("B:B").Copy .Range("B1")
.Range("A:B").Columns.AutoFit
End With
End Sub
