ich lasse per Makro Texte gegen abkürzungen ersetzen.
Das klappt auch in vielen Fällen sehr gut.
nur manche Sachen findet er nicht obwohl sie gleich aussehen.
In einer Spalte (erste der beiden Schleifen) ist die Trefferquote 99%.
Aus " ( 25 / 1827437.001 / Bilanz & Buchhaltung / 16 / / 00000000 / gekündigt )"
wird: " ( 25 / 1827437.001 / BIB / 16 / / 00000000 / gekündigt )"
Mein Sorgenkind ist die Spalte dahinter:
" ( 25 / 1827437.001 / Bilanz & Buchhaltung / 16 / gekündigt ) ( 25 / 1827437.001 / Buchführungs Plus / 43 / gekündigt ) ( 25 / 1827437.001 / Buchführungs Plus / / in Ansicht gekündigt ) ( 25 / 1827437.001 / ControllerPlus Excel-Basic Upd / / in Ansicht gekündigt ) ( 25 / 1827437.001 / BBS Buchen u.Bilanzieren / 45 / gekündigt ) ( 25 / 1827437.001 / BBS Buchen u.Bilanzieren / 43 / gekündigt ) ( 25 / 1827437.001 / Buchführungs Plus / / in Ansicht gekündigt ) ( 25 / 1827437.001 / Kontierungs-Praxis-abc / 43 / gekündigt )"
---> kein Treffer
Ich habe keinen blassen Schimmer was ich hier falsch mache.
Sind es vielleicht groß geschriebene Leerzeichen?
Oder muß ich am Code etwas ändern?
hier der Code:
Sub C_werte_ersetzen()
Dim WkSh_Q As Worksheet 'Die Tabelle wo die zu ersetzenden Werte in Spaalte AS stehen
Dim WkSh_A As Worksheet 'Die Tabelle wo die Umsetz-Daten stehen
Dim lzeile As Long 'Letzte Zeile der Umsetz-Tabelle
Dim ZUersetzenEnde As Long 'Letzte Zeile der zu ändernden Daten in Spalte AS
Dim ZweiteErsetzenEnde As Long 'Letzte Zeile der zu ändernden Daten in Spalte AS
Dim ersetzenEnde As Long 'Letzte Zeile der Suchtabelle
Dim letzteZ As Long 'Letzte Reihe ermitteln (zu ersetzende Werte)
'Dateinamen im "set" deklarieren
Set WkSh_Q = Worksheets("Daten") 'Tabelle mit den zu ersetzenden Daten
'Der Text steht in Tabelle3 und wird markiert
Set WkSh_A = Worksheets("Abkürzungen") 'Umsetz-Tabelle
'Die zu ersetzenden Werte in Spalte B
'Das Kürzel dafür in Spalte A
'Stop
'Letzte Zeile Suchtabelle setzen
Worksheets("Abkürzungen").Select
lzeile = ActiveSheet.UsedRange.Rows.Count
'Letzte Zeile Ersetzentabelle setzen
Worksheets("Daten").Select
letzteZ = ActiveSheet.UsedRange.Rows.Count
For ZUersetzenEnde = letzteZ To 2 Step -1
'If Len(Cells(ZUersetzenEnde, 45).Value) <> 0 Then ActiveCell.Select 'Zelle in Spalte AS
Cells(ZUersetzenEnde, 45).Select
With Selection 'die jetzt ausgewählte Zelle wird wie folgt behandelt:
For lzeile = 1 To WkSh_A.Range("A65536").End(xlUp).Row 'solange in Spalte A etwas steht
If InStr(ActiveCell.Value, WkSh_A.Range("B" & lzeile).Value) > 0 Then
ActiveCell.Value = Replace(ActiveCell.Value, _
WkSh_A.Range("B" & lzeile).Value, _
WkSh_A.Range("A" & lzeile).Value)
Exit For
End If
Next lzeile
End With
Next ZUersetzenEnde
'================und das gleiche mit der zweiten zu ersetzenden Spalte======
For ZweiteErsetzenEnde = letzteZ To 2 Step -1
'If Len(Cells(ZUersetzenEnde, 45).Value) <> 0 Then ActiveCell.Select 'Zelle in Spalte AS
Cells(ZweiteErsetzenEnde, 46).Select
With Selection 'die jetzt ausgewählte Zelle wird wie folgt behandelt:
For lzeile = 1 To WkSh_A.Range("A65536").End(xlUp).Row 'solange in Spalte A etwas steht
If InStr(ActiveCell.Value, WkSh_A.Range("B" & lzeile).Value) > 0 Then
ActiveCell.Value = Replace(ActiveCell.Value, _
WkSh_A.Range("B" & lzeile).Value, _
WkSh_A.Range("A" & lzeile).Value)
Exit For
End If
Next lzeile
End With
Next ZweiteErsetzenEnde
'Datei speichern
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\andyrs\Eigene Dateien\Projekt13_Verlag\Test-Dateien\Verlag_KüRü_Temp1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
End Sub
Wer von Euch kann mir da weiterhelfen?
Mein Dank geht schon jetzt in Eure Richtung.
Servus,
Anton