Abschneiden von Buchstaben und Zahlen VBA

[michel34497]

Hallo Leute!

Kannn mal einer mir auf die schnell mal helfen?
Suche eine Code für folgende aufgabe:

In einen Textfeld oder Label steht

Michael 333.01 S20
oder
Michael 333.01 S20.xlsm
oder
Michael 333.01 20 01

Möchte diesen Text dann so über eine Code in VBa so kürzen lassenl
das dann da steht

Michael 333.01
Bitte auch die Leerzeichen beachten.
Ist sowas möglich und wenn ja wer kann mir einen Tip geben?

[Ego]

Hallo Michel,

vielleicht hilft dir ja dieser Link:
http://www.herber.de/excelformeln und bitte suchen .../formeln.html?welcher=102

Nach deinen Beispielen könnte man auch den Text vor dem zweiten Leerzeichen ausgeben.
Dann wird die Formel einfacher.

[CitizenX]

Hi,

Code:

Option Explicit

Sub replaceString()
    Dim regex As Object, o
    Const myString = "Michael 333.01 20 01"
    Set regex = CreateObject("vbscript.regexp")
    
    With regex
        .ignorecase = True
        .Pattern = "(^[a-z]+\s*\d+\.?\d+)(.*?$)"
        Debug.Print .Replace(myString, "$1")
    End With

End Sub

VG
Steffen

[Fennek]

Hallo,

um nach dem zweiten Leerzeichen abzuschneiden, geht auch

Code:

Var = "Michael 33.001 24 qwe"
V = split(Var)
Neu = V(0) & V(1)

mfg

[snb]

Code:

msgbox left("Michael 333.01 etc.",14)

[michel34497]

Hallo!

Danke für eure Hilfe!
Ich habe folgendes daraus gebastelt.

Code:

Sub prcTesten(MasSu As String)
Const sPfade = "C:\Wartungspläne\"
Dim sOrdner       As String
Dim sUOrdner      As String
Dim sUOrdner2     As String
Dim sDatei        As String     ' die zu beschreibende Datei
Dim WkSh_Q        As Worksheet  ' das Quell-Tabellenblatt - die Herkunft
Dim WkSh_Z        As Worksheet  ' das Ziel-Tabellenblatt - das Ergebnis
   
   On Error Resume Next

  Var = MasSu
   V = Split(Var)
   sOrdner = V(0)
    sUOrdner = V(0) & " " & V(1)
     sUOrdner2 = V(0) & " " & V(1) & " " & V(2)
     sDatei = MasSu & ".xls"
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  Application.ScreenUpdating = False
  test = sPfade & sOrdner & "\" & sUOrdner & "\" & sDatei
  If Dir(sPfade & sOrdner & "\" & sUOrdner & "\" & sDatei) <> "" Then
     Workbooks.Open Filename:=test
     ThisWorkbook.Activate
     'Application.ActiveWindow.Visible = False
   ElseIf Dir(sPfade & sOrdner & "\" & sUOrdner2 & "\" & sDatei) <> "" Then
        test = sPfade & sOrdner & "\" & sUOrdner2 & "\" & sDatei

     Workbooks.Open Filename:=test
     ThisWorkbook.Activate

   Else
   
     MsgBox "Den angegebenen Ordner """ & sPfade & """" & Chr(10) & _
        "und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
        16, "   Hinweis für " & Application.UserName
     Exit Sub
  End If
   
           Sheets("Maschinenhistorie").Select                      'TabellenBlatt aufrufen
           Sheets("Kopf").Select                      'TabellenBlatt aufrufen
           Sheets("Maschinenhistorie").Select                      'TabellenBlatt aufrufen
         Stop
     
      Application.StatusBar = False
 
End Sub

Funktioniert auch fast!
Habe jetzt noch eine unbekannte um gewisse  .xls Dateien zu öffnen.
Beispiel:
C:\Wartungspläne\Michael\Michael 01\Michael 01.xls    
Das wäre dieser Code:   

Code:

sPfade & sOrdner & "\" & sUOrdner & "\" & sDatei

 C:\Wartungspläne\Michael\Michael 01 n3\Michael 01.xls   

 dann dieser Code

Code:

sPfade & sOrdner & "\" & sUOrdner2 & "\" & sDatei

Es kann aber sein das die xls Datei auch so aus sieht
C:\Wartungspläne\Michael\Michael 01\Michael 01 - S 1000 HA.xls    

Wie kann man den rot Makierten Text ignorieren um die .xls Datei zu öffnen?
Wer kann mir da noch mal einen Tipp geben? 
Da es schhon wieder spät ist versuche ich bis morgen noch eine BeispielDatei einzustellen, vieleicht geht es ja auch ohne.

[Kuwer]

Hallo Michael,

vielleicht so:

Sub prcTesten(MasSu As String)

 Const sPfade = "C:\Wartungspläne\"

 Dim sOrdner       As String

 Dim sUOrdner      As String

 Dim sUOrdner2     As String

 Dim sDatei        As String     ' die zu beschreibende Datei

 Dim WkSh_Q        As Worksheet  ' das Quell-Tabellenblatt - die Herkunft

 Dim WkSh_Z        As Worksheet  ' das Ziel-Tabellenblatt - das Ergebnis

  

 On Error Resume Next



 Var = MasSu

 V = Split(Var)

 sOrdner = V(0)

 sUOrdner = V(0) & " " & V(1)

 sUOrdner2 = V(0) & " " & V(1) & " " & V(2)

 sDatei = MasSu & "*.xls"

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 Application.ScreenUpdating = False

 test = sPfade & sOrdner & "\" & sUOrdner & "\" & Dir(sPfade & sOrdner & "\" & sUOrdner & "\" & sDatei)

 If Dir(test) <> "" Then

   Workbooks.Open Filename:=test

   ThisWorkbook.Activate

   'Application.ActiveWindow.Visible = False

 Else

   test = sPfade & sOrdner & "\" & sUOrdner2 & "\" & Dir(sPfade & sOrdner & "\" & sUOrdner2 & "\" & sDatei)

   If Dir(test) <> "" Then

     Workbooks.Open Filename:= test

     ThisWorkbook.Activate

   Else

     MsgBox "Den angegebenen Ordner """ & sPfade & """" & Chr(10) & _

       "und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _

       16, "   Hinweis für " & Application.UserName

     Exit Sub

   End If

 End If

  

 Sheets("Maschinenhistorie").Select                      'TabellenBlatt aufrufen

 'Stop

 Application.StatusBar = False

End Sub

Code eingefügt mit: Excel Code Jeanie


Gruß Uwe

[snb]

Deine Frage hat wenig mit Buchstaben und Zahlen zu tun.

Code:

Sub M_snb()
  c00= "C:\Wartungspläne\Michael\Michael 01\"
  c01="Michael 01"

  sn=filter(split(createobject("wscript.shell").exec("cmd /c dir """ & c00 & c01 & "*.xls"" /b/a-d").stdout.readall,vbcrlf),c01)

  if ubound(sn)>-1 then workbooks.open c00 & sn(0)
Edn Sub

[michel34497]

Hallo und Danke an alle!

Habe was erreicht!

Code:

Sub prcTesten(MasSu As String)
   'On Error Resume Next

  Var = MasSu '"Michael 33.001 24 qwe"
   V = Split(Var)
   sOrdner = V(0)
    sUOrdner = V(0) & " " & V(1)
     sUOrdner2 = V(0) & " " & V(1) & " " & V(2)
      sDatei = sUOrdner & ".xls"
       sDatei2 = sUOrdner2 & ".xls"
        sDatei3 = sUOrdner2 & "*" & ".xls"
         'Die Funktion Dir liefert immer den ersten gefundenen Eintrag
         sDatei3 = Dir(sPfade & sOrdner & "\" & sUOrdner & "\" & sDatei3)
         If sDatei3 <> "" Then sDatei3MitPfad = sPfade & sOrdner & "\" & sUOrdner & "\" & sDatei3
         
         If sDatei3 = "" Then
           sDatei3 = Dir(sPfade & sOrdner & "\" & sUOrdner2 & "\" & sDatei3)
           If sDatei3 <> "" Then sDatei3MitPfad = sPfade & sOrdner & "\" & sUOrdner2 & "\" & sDatei3
         End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  Application.ScreenUpdating = False

  If sDatei3MitPfad <> "" Then
   
   Set wb = Workbooks.Open(Filename:=sDatei3MitPfad)
 
   Else
   
     MsgBox "Den angegebenen Ordner """ & sPfade & """" & Chr(10) & _
        "und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
        16, "   Hinweis für " & Application.UserName
     Exit Sub
  End If
       wb.Activate
        wb.Sheets("Maschinenhistorie").Select                      'TabellenBlatt aufrufen
   
    Call eintrag
      Application.StatusBar = False
End Sub

funzt super