Office: Buchstaben entfernen, Zahlen belassen

jadwiga · 8. Januar 2021

Guten Abend an Alle.

Ich habe ein Makro gefunden, welches Buchstaben aus Zellen entfern und nur die Zahlen übrig lässt. (Ich hatte vor kurzem versucht, diese Aufgabe mit einem Array zu lösen, aber das hat nicht funktioniert.)

Das Makro funktioniert, aber ich möchte 2 Dinge ändern.

Es werden alle Buchstaben und Zeichen (also: alle Nicht-Zahlen) entfern. Es soll aber bestehen bleiben: Punkt, Komma, Klammer auf, Klammer zu, Plus, Minus: . , (-), (--), (+), (++).

Und: Ich habe in dieser Version als Bereich B2:C18 angegeben. Es können aber mehr Spalten sein und mehr Zeilen. Wie kann ich sagen: von B2 bis zur letzten Zelle in der letzten Spalte ?
Code:

Sub LaborwerteBuchstabenEntfernen()

Dim i As Integer
Dim Zahl As String
Dim Zelle As Range
Dim Suchbereich As Range

Set Suchbereich = Range("B2:C18")

For Each Zelle In Suchbereich
For i = 1 To Len(Zelle)
If IsNumeric(Mid(Zelle, i, 1)) Or Mid(Zelle, i, 1) = "," Then
Zahl = Zahl & Mid(Zelle.Value, i, 1)
End If
Next i
Zelle.Value = Zahl

Zahl = ""
Next

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Es wäre super, wenn mir jemand helfen könnten. Vielen Dank im Voraus und viele Grüße

Jadwiga

:)

lupo1 · 10. Januar 2021

Mit XL365 Betachannel ohne VBA:
=SUBSTITUTE.CHARS()
=SUBSTITUTE.STRINGS()

Der Steuerfuzzi · 10. Januar 2021

Hallo,

versuch es mal so:
Code:

Sub LaborwerteBuchstabenEntfernen()

Dim Suchbereich As Range
Dim arrSuchbereich As Variant
Dim strZahl As String
Dim h As Long, i As Long, j As Long

Set Suchbereich = Range("B2:C18")
arrSuchbereich = Suchbereich.Value

For i = 1 To UBound(arrSuchbereich, 1)
For h = 1 To UBound(arrSuchbereich, 2)
For j = 1 To Len(arrSuchbereich(i, h))
Debug.Print Asc(Mid(arrSuchbereich(i, h), j, 1))
Select Case Asc(Mid(arrSuchbereich(i, h), j, 1))
Case 40 To 41, 43 To 46, 48 To 57
strZahl = strZahl & Mid(arrSuchbereich(i, h), j, 1)
End Select
Next j
arrSuchbereich(i, h) = strZahl
strZahl = ""
Next h
Next i
Suchbereich.Value = arrSuchbereich

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Fennek11 · 10. Januar 2021

Noch eine Variante:

Code:

Sub Main
dim rng as range
set rng = Range("B2:C18")
for each c in rng
Tx = c.value
for b = 1 to len(Tx)
if mid(Tx,b,1) like "[0-9,.()+-]" then iNum = iNum & mid(Tx,b,1)
next b
c.offset(,3) = iNum
iNum = ""
next c
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

So ganz passt es noch nicht.

edwinbastler · 10. Januar 2021

man kann den Ausgangscode einfach erweitern.

Code:

Option Explicit

Sub LaborwerteBuchstabenEntfernen()

Dim i As Integer
Dim Zahl As String
Dim Zelle As Range
Dim Suchbereich As Range

Set Suchbereich = Range("B2:C18")

For Each Zelle In Suchbereich
For i = 1 To Len(Zelle)
If IsNumeric(Mid(Zelle, i, 1)) Or Mid(Zelle, i, 1) = "," _
Or Mid(Zelle, i, 1) = "-" Or Mid(Zelle, i, 1) = "(" _
Or Mid(Zelle, i, 1) = ")" Or Mid(Zelle, i, 1) = "." Then
Zahl = Zahl & Mid(Zelle.Value, i, 1)
End If
Next i
Zelle.Value = Zahl

Zahl = ""
Next

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Ergebnis ist aber weiterhin nicht so wie in der Datei erwartet und muss manuell korrigiert werden.

knobbi38 · 10. Januar 2021

Hallo Jadwiga,

hier mal eine VBA-Funktion, welche als udf aufgerufen werden könnte:
Code:

Public Function GetSpecialChars( _
ByVal StringValue As String, _
Optional ByVal SpecialChars As String = ".,()+-0123456789" _
) As String
Dim strBuffer As String
Dim i As Long, n As Long

n = 0
strBuffer = String(Len(StringValue), vbNullChar)

For i = 1 To Len(StringValue)
If InStr(SpecialChars, Mid(StringValue, i, 1)) > 0 Then
n = n + 1
Mid(strBuffer, n, 1) = Mid(StringValue, i, 1)
End If
Next

GetSpecialChars = Left(strBuffer, n)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aufruf: =GetSpecialChars(A1)
Bei Bedarf könnte man auch andere Zeichen mit übergeben, welche man extrahieren möchte. Z.B. mit
=GetSpecialChars(A1;":.,()+-0123456789")
würde zusätzlich auch der ":" mit zurückgeliefert.

Gruß Ulrich

jadwiga · 11. Januar 2021

Vielen Dank an alle für die Antworten.

@ edwinbastler: ich glaube, dein Vorschlag ist für mich am besten geeignet.

Die anderen Lösungsvorschläge werde ich mir auch ansehen, und mich mit dem Thema "Funktion" befassen, das ist mir neu.

Ich habe aber noch eine Bitte: wie kann ich den Bereich anpassen? Es können unterschiedlich viele Spalten und Zeilen sein. Der Bereich der Abfrage ist dynamisch.

Ich brauche so etwas wie "Set Suchbereich = Range("B2" & SpecialCells(xlLastCell)), ich bekomme das nicht hin! Vielleicht kann mir auch hier jemand helfen?

Liebe Grüße von
Jadwiga

jadwiga · 11. Januar 2021

Nach etwas herumprobieren habe ich es herausgefunden!
Man braucht 2 Variablen:

Dim LetzteZeile As Integer
Dim LetzteSpalte As Integer

LetzteZeile = Range("A1").SpecialCells(XlCellType.xlCellTypeLastCell).Row
LetzteSpalte = Range("A1").SpecialCells(XlCellType.xlCellTypeLastCell).Column

und diese dann in den Suchbereich einbauen:

Set Suchbereich = Range(Cells(2, 2), Cells(LetzteZeile, LetzteSpalte))

Nochmals vielen Dank für alle Antworten. Liebe Grüße von

Jadwiga

Office: Buchstaben entfernen, Zahlen belassen

Buchstaben entfernen, Zahlen belassen

Buchstaben entfernen, Zahlen belassen

Buchstaben entfernen, Zahlen belassen

Buchstaben entfernen, Zahlen belassen

Buchstaben entfernen, Zahlen belassen - Similar Threads - Buchstaben entfernen Zahlen

In einer Zelle Zahlen erkennen und trennen

Spalten Sortieren nach Zahlen mit Buchstaben (1a,1b usw)

Schnellsprung zu einer Zeile in einer Liste (Buchstabe)

Spalte A nach Buchstaben, dann erst nach Zahlen sortieren

Spezielle Buchstaben

Summewenns mit Datum und Zwei Buchstaben eingrenzen

Buchstaben und Unterstrich von Zahlen entfernen