Makro für suchen ersetzen in excelliste

os2 · 13. November 2019 um 14:56

Hallo,
kann mir bitte wer bei meinem Problem helfen?
Folgende Problematik:
Ich habe öfters Stücklisten zu übersetzen, dazu habe ich mir ein Tabellenblatt erstellt. In Spalte A Deutsch- die Übersetzung in Spalte B Englisch.
Habe längere Zeit gegogelt und folgendes raus gefunden:

http://www.profi-excel.de/vba_makros/mehrfach-suchen…

VBA:

Sub mehrfachSuchenUndErsetzen()
'sucht im aktiven Tabellenblatt jeweils die Eintraege aus
'suchArray und ersetzt mit ersetzArray
'09-2006
'E.Bimczok http://profi-excel.de
Dim suchArray()
Dim ersetzArray()
Dim k As Long
suchArray = Array(„a“, „b“, „c“)
ersetzArray = Array(„1“, „2“, „3“)
For k = LBound(suchArray) To UBound(suchArray)
Call ActiveSheet.UsedRange.Replace(suchArray(k), _
ersetzArray(k), _
, _
, _
False)
Next k
End Sub

Nun stehen die Übersetzungspaare im Tabellenblatt Translation Spalte A Übersetzung in B,
aktives Tabellenblatt ist die Stückliste. (sollte übersetzt werden)
Für Ihre Hilfe bin ich echt dankbar, weil diese Listen öfters bis 2500 Zeilen und 8 Spalten haben.

Wünsche schöne Woche

Gruß P
Meine Excel Version 2002

Riedl_Manfred · 13. November 2019 um 14:56

Hallo P,

wenn ich es richtig verstaden hab dann müste dein code in etwa so aussehen

Sub mehrfachSuchenUndErsetzen()

'sucht im aktiven Tabellenblatt jeweils die Eintraege aus
'suchArray und ersetzt mit ersetzArray
'09-2006
'E.Bimczok http://profi-excel.de
Dim suchArray()
Dim ersetzArray()
Dim k As Long

suchArray = Array(„a“, „b“, „c“)
ersetzArray = Array(„1“, „2“, „3“)

For k = LBound(suchArray) To UBound(suchArray)
Columns(„A:A“).Find(What:=suchArray(k), After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext).Activate
Range(„b“ & ActiveCell.Row).Value = ersetzArray(k)
Next k

End Sub

Anonym · 13. November 2019 um 14:56

wenn ich die frage richtig verstehe, würde ich programmieren:

Sub uebersetzen()
Dim translation As Range, suchen As Range, gefunden As Range
Set translation = Worksheets(„translation“).Range(„A:A“)

For Each suchen In Worksheets(„stueckliste“).UsedRange
If suchen Empty Then
Set gefunden = translation.Item(WorksheetFunction.Match(suchen, translation, 1))
If suchen = gefunden Then suchen = gefunden.Offset(0, 1)
End If
Next suchen
End Sub

die liste der übersetzungen muß sortiert sein.

viel erfolg!

Marc_d8fa63 · 13. November 2019 um 14:56

Hallo

möchtest du den englischen durch den deutschen text ersetzen?
benutzt du das englische wort zum übersetzen?

du könntest auch eine spalte in die Tabelle einfügen. in dieser holt er via
„=wenn(istfehler(vergleich(zelle_mit_englischem_Wort;bereich_übersetzungsexcel_englische_spalte;0));zelle_mit_englischem_Wort;index(bereich_übersetzungsexcel_deutsche_spalte;vergleich(zelle_mit_englischem_Wort;bereich_übersetzungsexcel_englische_spalte;0)))“
verwenden. mit der wennfunktion prüft er zuerst, ob das wort in der tabelle vorkommt, wenn nein, setzt er das englische ein, sonst das deutsche. diese formel müsste auch funktionieren, wenn die tabelle nicht sortiert ist.

die spalte und die formel kann per makro eingesetzt werden. falls dann die englische version nicht mehr benötigt wird, würde ich die spalte mit den formeln einmal kopieren und als werte wieder einfügen. anschliessend kannst du die spalte mit den englischen worten löschen.
alles kannst du per makro machen. wie es funktioniert, kannst du auch per makro aufzeichnen ausprobieren. wenn es dann nicht funktioniert, nochmals melden.

gruss
marc

Waldemar_Wesner · 13. November 2019 um 14:56

Sub test()
 Dim i As Range
 For Each i In Range("e5:e8") 'hier suchen
 'in der nächsten Spalte ersetzen
 i.Offset(0, 1).Value = FindeEn(i.Value)
 Next
End Sub

Function FindeEn(textDe As String) As String
On Error GoTo err
 'a1-a10 - Bereich mit deutschen Wörtern (Spalte "A")
 'in der Spalte "B" stehen Englische Übersetzungen
 Set r = Range("A1:a10").Find(What:=textDe, LookAt:=xlWhole, MatchCase:=False)
 FindeEn = r.Offset(0, 1).Value
 Exit Function
err:
 FindeEn = ""
End Function

Anonym_5b813eba76fe · 13. November 2019 um 14:56

Hallo,
versuche mal mit diesen 2 Makros, Deine Probleme zu lösen:

Sub Makro1()
Sheets(„Stückliste“).Select

'Wie viele Einträge stehen in Spalte A im Blatt Stückliste - Anzahl = last
last = [A65536].End(xlUp).Row

'Durchsuche die gesamte Stückliste
For i = 1 To last

'Sollte in Spalte B in Stückliste schon eine Übersetzung stehen - überspringen
If Cells(i, 2).Value „“ Then
GoTo nächste
End If

'Begriff aus Stückliste einlesen und in Variable „wort“ schreiben
wort = Cells(i, 1).Value

'Suchroutine aufrufen
Call suche
nächste:
Next i

End Sub

Sub suche()
'Falls keine Übersetzung gefunden wird - einfach mit der nächsten weiter
On Error GoTo weiter

'Suche im Blatt „Translation“ durchführen
Sheets(„Translation“).Select
Cells.Find(What:=wort, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

'Falls ein Eintrag in Translation gefunden wurde, dess Zeilennummer ermitteln
Zeile = ActiveCell.Row

'In der entprechenden Spalte die Übersetzung in die Variable „transl“ schreiben
transl = Cells(Zeile, 2).Value

'In der Tabelle Stückliste die Übersetzung eintragen
Sheets(„Stückliste“).Select
Cells(i, 2).Value = transl
weiter:
End Sub

Gruß,
Jochen

Franz_e6478d · 13. November 2019 um 14:56

Hallo P.,

nachfolgend das Makro mit erforderlichen Anpassungen. Im wesentlichen:

Abschnitt zum Einlesen der Daten für die Übersetzungsliste.
Prüfung, dass nicht versehentlich die Übersetzungsliste übersetzt wird.
Übersetzungsliste wird aufsteigend sortiert (eigentlich nur erforderlich, wenn Teile der Zellinhalte ersetzt werden sollen)
Bestätigung/Abfrage ob übersetzt werden soll
Ersetzen so eingestellt, dass nur ganze Zellinhalte verglichen und ersetzt werden (Lookat:=xlWhole). Ersetzen mit Lookat:=xlPart dürfte beim Übersetzen chaotische/falsche Begriffe erzeugen.

Gruß
Franz

Sub mehrfachSuchenUndErsetzen()

 'sucht im aktiven Tabellenblatt jeweils die Eintraege aus
 'suchArray und ersetzt mit ersetzArray
 '09-2006
 'E.Bimczok http://profi-excel.de modified Franz 2011-0718
 Dim wksTrans As Worksheet, wksAkt As Worksheet
 Dim suchArray()
 Dim ersetzArray()
 Dim k As Long, Zeile As Long

 Set wksAkt = ActiveSheet
 Set wksTrans = Worksheets("Translation")
 Const Zeile1 = 2 'Zeile mit 1. Übersetzungsdaten im Blatt "Translation"

 If wksAkt.Name = wksTrans.Name Then
 MsgBox "Im Blatt ""Translation"" darf das Übersetzungsmakro nicht eingesetzt werden!", \_
 vbInformation, "Übersetzen"
 GoTo Beenden
 End If
 If MsgBox("Daten im Tabellenblatt übersetzen", vbQuestion + vbYesNo, \_
 "Übersetzen") = vbNo Then GoTo Beenden

 'Übersetzungswerte in Datenarrays einlesen
 With wksTrans
 'letzte Zeile mit Daten
 Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
 'nach Spalte A aufsteigend sortieren ab Zeile 2 (Zeile1 hat Spaltentitel)
 With .Range(.Rows(Zeile1), .Rows(Zeile))
 .Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
 End With
 Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
 ReDim suchArray(Zeile1 To Zeile)
 ReDim ersetzArray(Zeile1 To Zeile)
 For Zeile = Zeile1 To Zeile
 suchArray(Zeile) = .Cells(Zeile, 1)
 ersetzArray(Zeile) = .Cells(Zeile, 2)
 Next Zeile
 End With

 'Daten in absteigender Reihenfolge ersetzen.
 'Ist wichtig, wenn "Lookat" nicht xlWhole sondern xlPart ist
 For k = UBound(suchArray) To LBound(suchArray) Step -1
 wksAkt.UsedRange.Replace what:=suchArray(k), Replacement:=ersetzArray(k), \_
 Lookat:=xlWhole, MatchCase:=False
 Next k
Beenden:
 'Variablen aufräumen
 Set wksTrans = Nothing: Set wksAkt = Nothing
 Erase suchArray(), ersetzArray()

End Sub

Thomas_Ramel · 13. November 2019 um 14:56

Grüezi os2

Ich habe öfters Stücklisten zu übersetzen, dazu habe ich mir
ein Tabellenblatt erstellt. In Spalte A Deutsch- die
Übersetzung in Spalte B Englisch.

Nun stehen die Übersetzungspaare im Tabellenblatt Translation
Spalte A Übersetzung in B,
aktives Tabellenblatt ist die Stückliste. (sollte übersetzt
werden)

Mit einer kleinen Umstellung des Codes sollte das wie folgt dann machbar sein:

Sub tr\_mehrfachSuchenUndErsetzen()
Dim suchArray As Variant
Dim ersetzArray As Variant
Dim k As Long

 With Worksheets("Translation")
 suchArray = Intersect(.UsedRange, .Columns(1))
 ersetzArray = Intersect(.UsedRange, .Columns(2))
 End With

 For k = LBound(suchArray) To UBound(suchArray)
 Call ActiveSheet.UsedRange.Replace(suchArray(k, 1), \_
 ersetzArray(k, 1), \_
 , \_
 , \_
 False)
 Next k

End Sub

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

martin_07bbfe · 13. November 2019 um 14:56

da kann ich leider nicht helfen

Hugo_a97cd9 · 13. November 2019 um 14:56

Hallo os2,

warum kann es nicht mittels SVERWEIS gemacht werden?
Mit SVERWEIS dient das deutsche Wort als kriterium im Ausgangsblatt und dem Blatt mit den Daten der Spalte A und B wird gesucht und in das Ausgangsblatt übertragen.

Gruß Hugo

os2 · 13. November 2019 um 14:56

Danke für alle freundlichen, hilfreichen Antworten.
Muss schon sagen erste Sahne die schnelle Hilfe.
Komme erst am Wochenende zum testen. Melde mich bei allen wies klappt. Vielen Dank bis bald
Grüße P

os2 · 13. November 2019 um 14:56

Danke für alle freundlichen, hilfreichen Antworten.
Muss schon sagen erste Sahne die schnelle Hilfe.
Komme erst am Wochenende zum testen. Melde mich bei allen wies klappt. Vielen Dank bis bald
Grüße P.

Anonym · 13. November 2019 um 14:56

wenn es um eine große liste der übersetzungspaare geht, rate ich zu einer funktion wie „match“ (oder „vlookup“), da sie einen suchbaum in eine sortierte liste nutzen kann und somit schneller als z.b. „find“ ist.

Softoldi_ad909c · 13. November 2019 um 14:56

Hallo,
habe leider keine Ahnung, wie das gehen soll.
mfg
Softoldi

Natator_4b5d3d · 13. November 2019 um 14:56

Hallo,
leider ist es mir nicht gelungen, den Code sinnvoll anzupassen.
Vllt. wäre es aber auch einfacher eine Datenbank mit den deutschen / englischen Bezeichnungen anzulegen, falls auch eine fixe Kennung mitgegeben wird (z.B. Artikelnummer).
Dann könnte man die Übersetzungen auch per SVERWEIS- Formel hinzufügen. Oder durch ein einfaches Makro, dass dann die Datensätze überschreibt.

Gruß
Natator

os2 · 13. November 2019 um 14:56

Hallo Franz,

endlich Wochenende, Zeit zum ausprobieren.
Makro eingefügt, prüft Zelleninhalt als gesamtes und ersetzt den gesamten Übersetzungswert -->Wahnsinn.
Genau das brauch ich.
Muss als nächstes mit XLpart probieren.
Englische Übersetzungsliste herrichten und überprüfen.
Vielen, vielen Dank dafür, wie viele Stunden stecken da drin?

Werde mich nach dem ausgiebigen Test noch mal melden.

Viele Grüße
P.

os2 · 13. November 2019 um 14:56

Hallo,

Trotzdem Danke

Viele Grüße
P.

os2 · 13. November 2019 um 14:56

Hallo,
vielen Dank für alle Mühe, probiere nun alle Antworten auf meine Anfrage durch. Makro von Franz funktioniert!!

Viele Grüße
P.

os2 · 13. November 2019 um 14:56

Hallo,
trotzdem Danke.

Viele Grüße
P.

os2 · 13. November 2019 um 14:56

Hallo Hugo,
habe mit sverweis schon mal gearbeitet, doch bin ich auf der Suche nach einem Makro. Teste nun alle Antworten durch. Bin echt erfreulich überrascht auf die vielen Antworten. Danke.

Viele Grüße

P.