Microsoft Excel

Herbers Excel/VBA-Archiv

Sonderzeichen | Herbers Excel-Forum


Betrifft: Sonderzeichen von: Peter
Geschrieben am: 23.11.2009 20:30:38

Hallo Leute. Ich habe folgendes Problem:

in meiner Kundendatenbank sollen die Spalten A:E auf mögliche Sonderzeichen ($;/;?;etc.) untersucht werden. Sofern in einer Zelle ein Sonderzeichen vorhanden ist soll die ganze Zeile des Datensatzes in ein zweites Tabellenblatt kopiert. Wenn kein Sonderzeichen in der Zelle ist soll nicht spassieren.

  

Betrifft: Zeilen mit Sonderzeichen kopieren von: NoNet
Geschrieben am: 23.11.2009 21:03:58

Hallo Peter,

mit folgendem Makro werden alle Zeilen mit "Sonderzeichen" in Spalten A:E in das Blatt "Sonderzeichen" kopiert :

Sub SonderzeichenZeilenKopieren()
    Dim rngZelle As Range, rngZeile As Range
    Dim strSonderzeichen As String
    Dim shSonderzeichen As Worksheet
    
    'Hier die Sonderzeichen eingeben :
    strSonderzeichen = "$%&!/()=~?~*~~+\^°<>|`'!@" & Chr(34)
    Set shSonderzeichen = Sheets("Sonderzeichen") 'In dieses Blatt wird kopiert
    
    For Each rngZeile In [A1:E1].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Rows
        For Each rngZelle In rngZeile.Cells
            If rngZelle.Value Like "*[" & strSonderzeichen & "]*" Then
                rngZeile.EntireRow.Copy _
                    shSonderzeichen.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                Exit For
            End If
        Next
    Next
End Sub
In der Zeile strSonderzeichen="..." musst Du angeben, welche "Sonderzeichen" gesucht werden sollen. 4 Besondere Zeichen gibt es dabei, die man nicht einfach eingeben kann :
~* sucht nach Sternchen (*)
~? sucht nach Fragezeichen (?)
~~ sucht nach Tilde (~)
CHR(34) sucht nach Anführungszeichen (")

Gruß, NoNet


  

Betrifft: AW: Zeilen mit Sonderzeichen kopieren von: Peter
Geschrieben am: 23.11.2009 21:12:28

Super! Vielen Dank


  

Betrifft: Alternative zu Sonderzeichen : White List von: NoNet
Geschrieben am: 23.11.2009 21:13:58

Hallo Peter,

noch eine Alternative zur Eingabe aller "Sonderzeichen" (das wäre eine "Black List") :
Gib einfach nur die gültigen Zeichen ("White List") an, diese MUSS mit einem Ausrufezeichen beginnen :

    'Oder : nur die gültigen Zeichen eingeben - mit Ausrufezeichen zu Beginn :
    strSonderzeichen = "!ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvxyz0123456789äöüÄÖÜß"
    'oder verkürzt :
    strSonderzeichen = "!A-Za-z 0-9äöüÄÖÜß"
Alle Zeilen, die ein Zeichen ausserhalb dieser "White List" beinhalten, werden kopiert !

Gruß, NoNet


  

Betrifft: AW: Sonderzeichen von: Josef Ehrensberger
Geschrieben am: 23.11.2009 21:13:24

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



Beiträge aus den Excel-Beispielen zum Thema "Sonderzeichen"