Buchstaben abschneiden

[michel34497]

Hallo Experten!
Ich suche nach einen Code der alle buchstaben in einer Textbox abschneidet bis auf den ersten.
Ist das möglich?

Ein Bsp.:  Hans1000.01 steht in der TextBox für die weitere Bearbeitung brauche ich nur H1000.01

Ist dies über VBA möglich?

Über jede Hilfe würde ich mich jetzt schon bedanken

[Gast 123]

Hallo erst mal ...

unten ein kurzer Makro Code als komplett Lösung. In den Const Zeilen must du -deinen Range Bereich- angeben, wo Hans drin steht. Bei mir zum Test war es "B3:B10".  Und den Offset in welche Spalte das Ergebnis geschrieben werden soll. Bei mir in der 2. Spalte rechts, kann auch jede andere Spalte sein  Für Anfaenger mag der Code verwirrend sein, Profis erkennen sofort das es eine normale Standard Simpel Variante ist. 

mfg  Gast 123

Code:

'29.9.2016   Gast 123   Clever Forum
'alle Buchstaben löschen   'Hans1000.01 

Const Bereich = "B3:B10"   'Bereich wo "Hans" steht
Const ofs = 2              'Offset für Ergebnis


Sub Buchstsaben_löschen()
Dim AC As Object, j As Integer
'Schleife für Cut und Text String
For Each AC In Range(Bereich)
  'Suche 1. Zahl im String
  For j = 1 To Len(AC)
     If IsNumeric(Mid(AC, j, 1)) Then
        'wenn Zahl gefunden neuen Text
        Txt = Left(AC, 1) & Mid(AC, j, 100)
        AC.Offset(0, ofs) = Txt:  Exit For
     End If
  Next j
Next AC
End Sub

[michel34497]

Hallo Gast123

Tausen dank für die Hilfe, habe das mal getstet und das ist erstmal genau was ich gesucht habe.
Versuche gerade das umzuschreiben für eine TextBox1 in einer Userform.
Ich hoffe es geht auch da mit diesen Code.
Nochmals Danke.

[Kuwer]

Hallo Michael,

Private Sub TextBox1_AfterUpdate()

 Dim i As Long

 'Suche 1. Zahl im String

 For i = 1 To Len(TextBox1)

    If IsNumeric(Mid(TextBox1, i, 1)) Then

       'wenn Zahl gefunden neuer Text

       TextBox1 = Left(TextBox1, 1) & Mid(TextBox1, i)

       Exit For

    End If

 Next i

End Sub

Gruß Uwe

[Gast 123]

Hi  Michael und Uwe

schöne Zusammenarbeit, gutes Forum Team Work, gefaellt mir.  Kurzer Thread mit guter Lösung!  Danke an alle ....

mfg  Gast 123

[michel34497]

Hallo Uwe
Hallo Gast123,

Danke nochmals für eure Hilfe.
@ Uwe geht super

Habe aber noch ein frage kann man den Code so erweitern das er Leerzeichen erkennt und löscht?
Hab da was im netz gefunden komme aber nicht richtig weiter.
Scheitere dabei dies auf die Textbox umzuschreiben
das habe ich gefunden

Code:

Sub Leerzeichen_entfernen()
Dim i As Integer
Dim Zeichen As Integer
   For i = 1 To 10
       For Zeichen = 1 To Len(Cells(i, 1))
       If Mid(Cells(i, 1), Zeichen, 1) = " " Then
           If LCase(Mid(Cells(i, 1), Zeichen + 1, 1)) = Mid(Cells(i, 1), Zeichen + 1, 1) Then
               Cells(i, 1) = Left(Cells(i, 1), Zeichen - 1) + Mid(Cells(i, 1), Zeichen + 1)
           End If
       End If
       Next
   Next
End Sub

Das habe ich daraus gemacht

Code:

Dim a As Integer
Dim Zeichen As Integer
      For Zeichen = 1 To Len(TextBox1)
       If Mid(TextBox1, Zeichen, 1) = " " Then
       Stop
       TextBox1 = TextBox1.Replace(" ", "") 'Right(TextBox1, Zeichen - 1) & Mid(TextBox1, a)
           End If
       End If
       Next

Ab hier streikt der Code

Code:

       TextBox1 = TextBox1.Replace(" ", "")

Er Kennt replace nicht.
Mir fehlt eigtlich nur noch, wenn er das leerzeichen gefunden hat dies zu löschen.
Könnt ihr mir dabei nochmal hilfestellung geben?

[Kuwer]

Hallo Michael,

Private Sub TextBox1_AfterUpdate()

 Dim i As Long

 TextBox1 = Replace(TextBox1, " ", "")

 'Suche 1. Zahl im String

 For i = 1 To Len(TextBox1)

    If IsNumeric(Mid(TextBox1, i, 1)) Then

       'wenn Zahl gefunden neuer Text

       TextBox1 = Left(TextBox1, 1) & Mid(TextBox1, i)

       Exit For

    End If

 Next i

End Sub

Gruß Uwe

[michel34497]

Hallo Uwe!

Suuuuuuuuuuuper.

Genau das was ich haben wollte!
Ich schliese mich von Gast123 an "schöne Zusammenarbeit, gutes Forum Team Work, gefaellt mir."
Nochmals Tausend Dank für die Hilfe an euch

[michel34497]

Hallo!

Leider ist eine neue Herausforderung aufgetreten! Unser Controling hat eine ander Schreibweis wie wir.
Der code Funtzt soweit sehr gut!
Zum Code:
Leerzeichen entfernen geht.
Die Buchstaben abschneiden geht.

Jetzt müsste der Code nach der letzten gefunden Zahl alles andere noch abschneiden.
Bsp:
Am anfang steht in der TextBox1 Boy 25.01 M
Kann aber auch sein das in derTextBox1 Boy25.01M123 oder Boy 25.01 M1 B
Nach dem jetzigen Code durchlauf  B25.01M oder B25.10M123 oder B25.01M1B
Jetzt darf eigtenlich nur noch B25.01 in der TextBox stehen, ohne eine nachfolge von Buchstaben oder Zahlen!

Was muss geändert werden und wo mache ich mit diesen Code den Fehler das nach der letzten Zahl nicht alles abgeschnitten wird?

Code:

TextBox1 = Replace(TextBox1, " ", "") 'Leerzeichen entfernen
'Suche 1. Zahl im String
For a = 1 To Len(TextBox1)
   If IsNumeric(Mid(TextBox1, a, 1)) Then
      'wenn Zahl gefunden neuer Text
      TextBox1 = Left(TextBox1, 1) & Mid(TextBox1, a)
      Exit For
   End If
Next a
      TextBox1 = Left(TextBox1, Len(TextBox1) - 1)

Ich hoffe es geht auch so ohne die Dateien mit anzuhängen

[Kuwer]

Hallo Michael,

teste mal so:

Private Sub TextBox1_AfterUpdate()

 Dim i As Long, j As Long

 TextBox1 = Replace(TextBox1, " ", "")

 'Suche 1. Zahl im String

 For i = 1 To Len(TextBox1)

   If IsNumeric(Mid(TextBox1, i, 1)) Then

     'wenn Zahl gefunden neuer Text

     For j = 1 To Len(TextBox1) - i + 1

       If Not IsNumeric(Mid(TextBox1, i, j)) Then Exit For

     Next j

     TextBox1 = Left(TextBox1, 1) & Mid(TextBox1, i, j - 1)

     Exit For

   End If

 Next i

End Sub

Gruß Uwe