Schleife Buchstaben löschen Zahlen bleiben stehen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael,
was eigentlich möchtest du? Sind die Ergebnisse 2 und 122 für dich richtig oder falsch?
So kommen diese Ergebnisse mit der Formel von www.excelformeln.de raus:

	A	B
1	adventure (2)	2
2	kost (122)	122
3	x	0
4		0

Formeln der Tabelle

Zelle	Formel
B1	{=SUMME((TEIL(0&A1;KGRÖSSTE(WENN(ISTZAHL(TEIL(0&A1;ZEILE($1:$256); 1)1); ZEILE($1:$256); 1); ZEILE($1:$256)); 1)1)*10^(ZEILE($1:$256)-1))}

Enthält Matrixformel:
Umrandende { } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!

Matrix verstehen

Einen Nachteil hat die Formel noch: Wenn im Text keine Ziffer vorkommt, gibt sie eine Null aus.
Das ließe sich aber wohl auch noch beheben.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Public Sub NurZiffern() Dim lZeile As Long Dim sZeichen As String Dim iPosit As Integer With Worksheets("Tabelle1") For lZeile = 1 To .Cells(Rows.Count, 1).End(xlUp).Row For iPosit = 1 To Len(Range("A" & lZeile).Value) sZeichen = Mid(Range("A" & lZeile), iPosit, 1) If IsNumeric(sZeichen) Then Range("B" & lZeile).Value = Range("B" & lZeile).Value & sZeichen End If Next iPosit Next lZeile End With End Sub

Sub TEST() Dim Bereich As Range, Zelle1 As String Dim Wert As Long, A As Long On Error Resume Next If Cells.SpecialCells(xlCellTypeConstants) Then Zelle1 = Cells.SpecialCells(xlCellTypeConstants).Address End If If Cells.SpecialCells(xlCellTypeFormulas) Then If Zelle1 > "" Then Zelle1 = Zelle1 & "," & Cells.SpecialCells(xlCellTypeFormulas).Address Else Zelle1 = Cells.SpecialCells(xlCellTypeFormulas).Address End If End If On Error GoTo 0 For Each Bereich In Range(Zelle1) For A = 1 To Len(Bereich) If IsNumeric(Mid(Bereich, A, 1)) Then Wert = Wert & Mid(Bereich, A, 1) End If Next A Bereich = Wert Wert = 0 Next Bereich End Sub

Sub TEST() Dim Bereich As Range, Zelle1 As String Dim Wert As Long, A As Long On Error Resume Next If Cells.SpecialCells(xlCellTypeConstants) Then Zelle1 = Cells.SpecialCells(xlCellTypeConstants).Address End If If Cells.SpecialCells(xlCellTypeFormulas) Then If Zelle1 > "" Then Zelle1 = Zelle1 & "," & Cells.SpecialCells(xlCellTypeFormulas).Address Else Zelle1 = Cells.SpecialCells(xlCellTypeFormulas).Address End If End If On Error GoTo 0 For Each Bereich In Range(Zelle1) If Bereich > "" Then For A = 1 To Len(Bereich) If IsNumeric(Mid(Bereich, A, 1)) Then Wert = CDbl(Mid(Bereich, A, 1)) End If Next A Bereich = Wert End If Wert = 0 Next Bereich End Sub

Public Sub NurZiffern() Dim lZeile As Long Dim sZeichen As String Dim iPosit As Integer Dim sErgebnis As String With Worksheets("Tabelle1") ' Tabellenblattnamen ggf. anpassen !!! For lZeile = 1 To .Cells(Rows.Count, 1).End(xlUp).Row sErgebnis = "" ' die Werte werden in Spalte A ab Zeile 1 angenommen !!! For iPosit = 1 To Len(Range("A" & lZeile).Value) ' Werte aus Spalte A sZeichen = Mid(Range("A" & lZeile), iPosit, 1) If IsNumeric(sZeichen) Then sErgebnis = sErgebnis & sZeichen End If Next iPosit Range("A" & lZeile).Value = sErgebnis * 1 ' Ergebnis in Spalte A Next lZeile End With End Sub

Hallo Michael,
wenn auch leere Zellen oder Zellen ohne Ziffern vorkommen, dann so:
'
' wenn alles in der gleichen Zelle passieren soll, dann so:
'


Public Sub NurZiffern()
Dim lZeile    As Long
Dim sZeichen  As String
Dim iPosit    As Integer
Dim sErgebnis As String
With Worksheets("Tabelle12") ' Tabellenblattnamen ggf. anpassen !!!
For lZeile = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
sErgebnis = "" ' die Ausgabe-Variable leeren/löschen
'         die Werte werden in Spalte A ab Zeile 1 angenommen !!!
For iPosit = 1 To Len(.Range("A" & lZeile).Value) ' Werte aus Spalte A
sZeichen = Mid(.Range("A" & lZeile), iPosit, 1)
If IsNumeric(sZeichen) Then
sErgebnis = sErgebnis & sZeichen
End If
Next iPosit
If sErgebnis  "" Then ' wurde eine Zahl gefunden ?
.Range("A" & lZeile).Value = sErgebnis * 1 ' Ergebnis nach Spalte A
End If
Next lZeile
End With
End Sub

Gruß Peter

Sub alles_ausser_Ziffern_löschen() Dim rngBereich As Range Dim i As Integer Set rngBereich = Selection For i = 3 To 255 Select Case i Case 48 To 57 '--- Zahlen werden nicht gelöscht Case 42, 63 '--- Platzhalter ? * müssen gesondert betrachtet werden rngBereich.Replace "~" & Chr(i), "" Case Else '--- alles andere: Hasta la Vista, Zeichen rngBereich.Replace Chr(i), "" End Select Next End Sub

Sub Buchstaben_löschen() Dim rngBereich As Range Dim i As Integer On Error Resume Next Set rngBereich = Selection.SpecialCells(xlCellTypeConstants, 2) On Error GoTo 0 If rngBereich Is Nothing Then Exit Sub Application.ScreenUpdating = False For i = 3 To 255 Select Case i Case 48 To 57 Case 42, 63 rngBereich.Replace "~" & Chr(i), "", xlPart Case Else rngBereich.Replace Chr(i), "", xlPart End Select Next Application.ScreenUpdating = True End Sub

Sub alles_ausser_Zeichen_löschen_() Dim rngBereich As Range Dim i As Integer Dim j As Integer Columns("A:A").Select Set rngBereich = Selection For i = 40 To 41 rngBereich.Replace Chr(i), "" Next For j = 48 To 57 rngBereich.Replace Chr(j), "" Next End Sub

Sub alles_ausser_Zeichen_löschen2_() Dim i As Integer With Columns("A:A") .Replace Chr(40), "", xlPart .Replace Chr(41), "", xlPart For i = 48 To 57 .Replace Chr(i), "", xlPart Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Schleife Buchstaben löschen Zahlen bleiben stehen

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

123 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schleife Buchstaben löschen Zahlen bleiben stehen

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

123 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread