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