ASCII-Zeichen löschen

Hallo,

ich habe einen Code zur Löschung von bestimmten ASCII-Zeichen in einem frühreren Beitrag von diesem Forum gefunden. Der Code löscht bestimmte ASCII-Zeichen. Ich muss in Spalte B einer Exceldatei alle Zeichen außer Zahlen und dem Bindestrich löschen, ich habe versucht den Code so anzupassen dass das Makro das macht aber jetzt werden alle Zeichen gelöscht. Könnte mir jemand einen Tip geben wie ich den Code verändern muss.

Sub Textzeichen_löschen()
Dim i As Long

For i = 1 To IIf(Len(Cells(Rows.Count, 2)), Rows.Count, Cells(Rows.Count, 2).End(xlUp).Row)
Cells(i, 2).Value = OnlyAscii(Cells(i, 2).Value)
Next
End Sub

Function OnlyAscii(ByVal s As String) As String
Dim i As Long, c As String

For i = 1 To Len(s)
c = Mid(s, i, 1)
If AscW(c) > 58 And AscW(c) 47 And AscW(c) = 44 Then OnlyAscii = OnlyAscii & c

Next
End Function

Die Datei in der ich die Zeichen löschen muss ist unter

https://www.herber.de/bbs/user/158730.xlsx

erreichbar.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub NurZahlenMitBindestrich() Dim i&, j&, k&, varAusgabe With Tabelle1 For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To Len(.Cells(i, 2)) If Mid(.Cells(i, 2), j, 1) = "-" Then If IsNumeric(Mid(.Cells(i, 2), j - 1, 1)) Then varAusgabe = varAusgabe & "-" End If Else For k = 0 To 9 If Mid(.Cells(i, 2), j, 1) = k Then varAusgabe = varAusgabe & k Next k End If Next j .Cells(i, 2) = varAusgabe varAusgabe = "" Next i End With End Sub

Hallo Paul,

Dein Beipiel ist nicht besonders hilfreich. Ich hoffe, ich habe dein Anliegen trotzdem verstanden.

Füge folgende Code in einem allgemeine Modul (kein Blatt-Modul)

Public Function Putzen(ByVal Target As Range)
Dim R
    Set R = CreateObject("VBScript.RegExp")
    R.Pattern = "[^0-9^\-]+" 'regular Expression für alle Zeichen, die weder 0 bis 9 noch "-" sind
    Putzen = R.Replace(Target.Value, "") 'ersetze die gegeben Pattern durch nichts
End Function

Dann kannst Du als Formel
= Putzen(B8)
oder
=Putzen([@Column2])
verwenden.

Wenn Du lieber ein "auf der Stelle ersetzen" bevorzügt, füge folgende Prozedure hinzu:

Public Sub Selection_putzen()
Dim Z As Range
    Application.EnableEvents = False
    For Each Z In Selection.Cells
        Z.Value = Putzen(Z)
    Next
    Application.EnableEvents = True
End Sub

Zielbereich markieren, Alt+F8 drucken, "Selektion_putzen" ausführen.

VG
Yal

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread