Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
828to832
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
828to832
828to832
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

ersetzen mit ungefährer Übereinstimmung

ersetzen mit ungefährer Übereinstimmung
11.12.2006 16:57:00
Anton
Hallo Leute,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ersetzen mit ungefährer Übereinstimmung
12.12.2006 15:46:56
Luc:-?
Hallo Anton,
da hast du dich ja an was rangetraut...!
Also, wenn das Pgm im Prinzip fkt, wird es schon nicht so falsch sein. Dann wird es wohl an den VglDaten liegen. Eine kleine Abweichung und schon geht's nicht mehr. Wäre mir viel zu aufwendig und wacklig! Entweder musst du Alternativen vorsehen oder das zu ändernde Material erst mal in einem 1.Schritt "normieren", d.h. mit vbFkt Replace unnötige bzw doppelte Leer- und wie Leerzeichen aussehende Zeichen und sonstigen Müll beseitigen. Das geht auch sehr gut mit meiner udFkt MaskOn, die du im Herber-Archiv finden müsstest. Was dann noch übrig bleibt, sollte sich gut ersetzen lassen. Mit MaskOn kannst du auch numerische und alfabetische Teile getrennt bearbeiten, musst sie dann nachher nur wieder richtig zusammensetzen. Außerdem könntest du lange Texte mit der vbFkt Split in Einzelteile zerlegen, die sich mit Instr besser bearbeiten lassen.
Gruß Luc :-?
PS: Hatte übrigens mal ein VBA-Pgm geschrieben, das Texte in Vorspalten je nach gewählter Spaltenbreite automatisch kürzt. War Teil einer teilautomatischen Tabellengenerierung. Weiß also, worauf es ankommt, auch wenn dein Problem etwas anders liegt.
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige