Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
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

es soll nicht immer Ersetzt werden

es soll nicht immer Ersetzt werden
18.12.2006 09:02:50
Anton
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: es soll nicht immer Ersetzt werden
18.12.2006 10:16:35
Luschi
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
Anzeige
AW: es soll nicht immer Ersetzt werden
18.12.2006 10:46:44
Anton
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"?
AW: es soll nicht immer Ersetzt werden
18.12.2006 10:49:00
Luschi
Hallo Anton,
natürlich so:
Set rg_Q = WkSh_Q.Cells(BearbeitungsZeile, BearbeitungsSpalte)
Gruß von Luschi
aus klein-Paris
Anzeige
AW: es soll nicht immer Ersetzt werden
18.12.2006 11:19:40
Anton
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.
Anzeige
hat ihn gefunden Danke
18.12.2006 11:30:28
Anton
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige