AW: Sonderzeichen
23.11.2009 21:13:24
Josef
Hallo Peter,
probier mal. (Code vorher anpassen! Siehe Kommentar)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub copySpecialCharacters()
Dim rng As Range, rngCopy As Range
Dim lngLast As Long, intIndex As Integer
Dim strCharacters() As Variant
strCharacters = Array("!", "§", "$", "%", "&", "/", "?") 'hier die Sonderzeichen eintragen
With Sheets("Tabelle1") 'Quelltabelle - Anpassen
lngLast = Application.Max(2, .Cells(Rows.Count, 1).End(xlUp).Row)
.Columns(6).Insert
.Range("F2:F" & CStr(lngLast)).Formula = "=A2&B2&C2&D2&E2"
For Each rng In .Range("F2:F" & CStr(lngLast))
For intIndex = 0 To UBound(strCharacters)
If InStr(1, rng.Text, strCharacters(intIndex)) > 0 Then
If rngCopy Is Nothing Then
Set rngCopy = rng.Offset(0, -5).Resize(, 5)
Else
Set rngCopy = Union(rngCopy, rng.Offset(0, -5).Resize(, 5))
End If
Exit For
End If
Next
Next
.Columns(6).Delete
End With
If Not rngCopy Is Nothing Then rngCopy.Copy Sheets("Tabelle2").Range("A2") 'Ziel - Anpassen!
Set rngCopy = Nothing
Set rng = Nothing
End Sub
Gruß Sepp