Herbers Excel-Forum - das Archiv

es soll nicht immer Ersetzt werden

Bild

Betrifft: es soll nicht immer Ersetzt werden
von: Anton

Geschrieben am: 18.12.2006 09:02:50
Hallo Leute,
mit dem unten angelieferten Code sollen bestimmte Begriffe gegen deren Abkürzungen ausgetauscht werden.
Wenn der vorhandene Begriff nicht in der Abkürzungsliste steht soll nicht ersetzt werden.
Statt dessen soll dieser Begriff auf ein anderes Blatt kopiert werden.
Mein Makro tauscht den "nicht gefundenen" Begriff gegen einen leeren Eintrag aus.
Also ist es mir dann auch nicht möglich in einer zweiten Runde die Nichtabkürzungen auf ein neues Blatt zu listen.
Hier mein Code:
Sub D_ersetzen_gekündigte()
Dim WkSh_Q  As Worksheet   'Die Tabelle wo die zu ersetzenden Werte stehen
Dim WkSh_A  As Worksheet   'Die Tabelle wo die Umsetz-Daten stehen
Dim lzeile  As Long        'Letzte Reihe ermitteln (zu ändernden Daten)
Dim letzteZ As Long        'Letzte Reihe ermitteln (zu ersetzende Werte)
Dim BearbeitungsZeile As Long     'Bearbeitungs-Zeile
Dim BearbeitungsSpalte As Integer 'Bearbeitungs-Spalte
Dim letzteS As Integer     'Letzte Spalte ermitteln (zu ersetzende Werte)
'Dateinamen im "set" deklarieren
Set WkSh_Q = Worksheets("gekündigte")   'Tabelle mit den zu ersetzenden Daten
Set WkSh_A = Worksheets("Abkürzungen")    'Umsetz-Tabelle
'Die zu ersetzenden Werte in Spalte B
'Das Kürzel dafür in Spalte A
'Letzte Zeile Suchtabelle setzen
Worksheets("Abkürzungen").Select
lzeile = ActiveSheet.UsedRange.Rows.Count
'Letzte Zeile Ersetzentabelle setzen
Worksheets("gekündigte").Select
letzteZ = ActiveSheet.UsedRange.Rows.Count
'Letzte Spalte Ersetzentabelle setzen
letzteS = ActiveSheet.UsedRange.Columns.Count
For BearbeitungsSpalte = letzteS - 4 To 3 Step -7
For BearbeitungsZeile = letzteZ To 1 Step -1
If (Cells(BearbeitungsZeile, BearbeitungsSpalte).Value) <> "" Then
Cells(BearbeitungsZeile, BearbeitungsSpalte).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(1, ActiveCell.Value, WkSh_A.Range("B" & lzeile).Value, vbTextCompare) > 0 Then
Cells(BearbeitungsZeile, BearbeitungsSpalte).Value = WkSh_A.Range("A" & lzeile).Value
Exit For
'          Else: Sheets("nicht_gefunden").Cells(BearbeitungsZeile, 1) = Cells(BearbeitungsZeile, BearbeitungsSpalte).Value
'                Sheets("nicht_gefunden").Cells(BearbeitungsZeile, 2) = "Zeile " & BearbeitungsZeile & ", Datensatz " & BearbeitungsSpalte / 7 & "."
End If
Next lzeile
End With
End If
Next BearbeitungsZeile
Next BearbeitungsSpalte
End Sub

Wer von Euch kann mir bitte weiterhelfen?
Mein Dank geht schon jetzt in Eure Richtung.
Servus,
Anton
Bild

Betrifft: AW: es soll nicht immer Ersetzt werden
von: Luschi

Geschrieben am: 18.12.2006 10:16:35
Hallo Anton,
habe mal den Vba-Code so angepaßt, das erst nach dem Schleifenende der inneren For-Schleife geprüft wird, ob der Ersetzungswert gefunden wurde.
Zudem wurden die Select-Befehle rausgenommen und durch die Application-Befehle die Verarbeitungs-Geschwindigkeit erhöht:
Sub D_ersetzen_gekündigte()
Dim WkSh_Q  As Worksheet   'Die Tabelle wo die zu ersetzenden Werte stehen
Dim WkSh_A  As Worksheet   'Die Tabelle wo die Umsetz-Daten stehen
Dim rg_Q As Range
Dim lzeile  As Long        'Letzte Reihe ermitteln (zu ändernden Daten)
Dim letzteZ As Long        'Letzte Reihe ermitteln (zu ersetzende Werte)
Dim BearbeitungsZeile As Long     'Bearbeitungs-Zeile
Dim BearbeitungsSpalte As Integer 'Bearbeitungs-Spalte
Dim letzteS As Integer     'Letzte Spalte ermitteln (zu ersetzende Werte)
Dim ok As Boolean           'ok = True - Wert für Ersetzung gefunden, sont nicht gefunden
Dim zeilenZaehler As Long   'für Tabelle "nicht_gefunden", damit keine großen Zeilenlücken entstehen
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Dateinamen im "set" deklarieren
Set WkSh_Q = Worksheets("gekündigte")   'Tabelle mit den zu ersetzenden Daten
Set WkSh_A = Worksheets("Abkürzungen")    'Umsetz-Tabelle
'Die zu ersetzenden Werte in Spalte B
'Das Kürzel dafür in Spalte A
'Select-Befehl ist meist nicht erforderlich
'Letzte Zeile Suchtabelle setzen
''Worksheets("Abkürzungen").Select
lzeile = WkSh_A.UsedRange.Rows.Count
'Letzte Zeile Ersetzentabelle setzen
''Worksheets("gekündigte").Select
letzteZ = WkSh_Q.UsedRange.Rows.Count
'Letzte Spalte Ersetzentabelle setzen
letzteS = WkSh_Q.UsedRange.Columns.Count
zeilenZaehler = 3
For BearbeitungsSpalte = letzteS - 4 To 3 Step -7
For BearbeitungsZeile = letzteZ To 1 Step -1
Set rg_Q = WkSh_Q.Cells(BearbeitungsZeile, BearbeitungsSpalte).Value
With rg_Q  'die jetzt ausgewählte Zelle wird wie folgt behandelt:
If rg_Q.Value <> "" Then
''Cells(BearbeitungsZeile, BearbeitungsSpalte).Select
ok = False
For lzeile = 1 To WkSh_A.Range("A65536").End(xlUp).Row 'solange in Spalte A etwas steht
If InStr(1, .Value, WkSh_A.Range("B" & lzeile).Value, vbTextCompare) > 0 Then
.Value = WkSh_A.Range("A" & lzeile).Value
ok = True
Exit For
End If
Next lzeile
If Not ok Then   'Begriff nicht gefunden
zeilenZaehler = zeilenZaehler + 1
Worksheets("nicht_gefunden").Cells(zeilenZaehler, 1) = .Value
Worksheets("nicht_gefunden").Cells(BearbeitungsZeile, 2) = _
"Zeile " & BearbeitungsZeile & ", Datensatz " & BearbeitungsSpalte / 7 & "."
End If
End If
End With
Next BearbeitungsZeile
Next BearbeitungsSpalte
Set rg_Q = Nothing
Set WkSh_Q = Nothing
Set WkSh_A = Nothing
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Gruß von Luschi
aus klein-Paris
Bild

Betrifft: AW: es soll nicht immer Ersetzt werden
von: Anton

Geschrieben am: 18.12.2006 10:46:44
Hallo Luschi,
erstmal vielen Dank für Deinen Code.
Zu Erst habe ich mir mal genauer angeguckt wie es vielleicht auch geht.
Dann ist bei einem Testlauf eine Fehlermeldung aufgetaucht.
"Objekt nicht definiert" heißt es
Der Debugger leuchtet mir dann diese Zeile an:
Set rg_Q = WkSh_Q.Cells(BearbeitungsZeile, BearbeitungsSpalte).Value
kannst Du bitte nochmal drübergucken?
schöne Grüße aus der Goldstadt,
servus,
Anton
PS: wo liegt denn "klein Paris"?
Bild

Betrifft: AW: es soll nicht immer Ersetzt werden
von: Luschi
Geschrieben am: 18.12.2006 10:49:00
Hallo Anton,
natürlich so:
Set rg_Q = WkSh_Q.Cells(BearbeitungsZeile, BearbeitungsSpalte)
Gruß von Luschi
aus klein-Paris
Bild

Betrifft: AW: es soll nicht immer Ersetzt werden
von: Anton

Geschrieben am: 18.12.2006 11:19:40
Hallo Luschi,
vielen Dank für Deine wirksame Korrektur.
Nur eines habe ich noch:
Der Ort des "nicht gefundenen" Datensatz wird leider nicht eingefügt.
Obwohl der STOP-Befehl für BearbeitungsZeile und BearbeitungsSpalte Werte anzeigt.
Hier der Code-Ausschnitt:
If Not WertGefunden Then 'Begriff nicht gefunden
zeilenZaehler = zeilenZaehler + 1
Worksheets("nicht_gefunden").Cells(zeilenZaehler, 1) = .Value
Worksheets("nicht_gefunden").Cells(BearbeitungsZeile, 2) = _
"Zeile " & BearbeitungsZeile & ", Datensatz " & BearbeitungsSpalte / 7 & "."
End If
Woran könnte es liegen?
Servus,
Anton
PS: Das kleine Städtchen namens Pforzheim wird wegen der Schmuck- und Uhren-industrie
"Goldstadt" genannt.
Bild

Betrifft: hat ihn gefunden Danke
von: Anton

Geschrieben am: 18.12.2006 11:30:28
Hallo Luschi,
wenn ich die Variable anpasse,
ist auch alles da.
-Ich hatte nur nicht weit genug unten geschaut....
If Not WertGefunden Then 'Begriff nicht gefunden
zeilenZaehler = zeilenZaehler + 1
Worksheets("nicht_gefunden").Cells(zeilenZaehler, 1) = .Value
Worksheets("nicht_gefunden").Cells(zeilenZaehler, 2) = _
"Zeile " & BearbeitungsZeile & ", Datensatz " & BearbeitungsSpalte / 7 & "."
End If
Hochmals herzlichen Dank.
Servus,
Anton
 Bild
Excel-Beispiele zum Thema "es soll nicht immer Ersetzt werden"
CommandButtons sollen auf Schaltflächen-Klick deaktiviert werden Hyperlinks sollen mit Quell- und Zieladresse gelistet werden
Labelwerte werden beim Verlassen einer TextBox berechnet Details von Verknüpfungen sollen aufgelistet werden
Werte aus Tabellenblatt-TextBoxes sollen addiert werden Anzeige, wenn Listenwerte gefunden werden