---

Hallo zusammen,

bin leider nicht so bewandert was die Makroprogrammierung betrifft.

Habe mir ein Makro gebastelt das mir aus einem bestehenden Sheet die Zeilen in ein neues Sheet umsortiert.
Funzt soweit wunderbar.
Nun möchte ich eine Text aus bestimmten Zellen bis zu einem String löschen.

Beispiel:
Ausgangssituation: "777777W04A"
Ergebniss soll sein "W04A"
Man könnte alles bis zu dem "W" weglöschen, da sich die Zahlen nachfolgend ändern können.

Wie kann ich das in mein Makro einbinden?
Die Werte befindet sich in der Spalte "B" die dann in die entsprechenden Zeilen im neuen Sheet übertragen werden.

Hier mal mein Code
Ensprechende Zeile ist "Fett" markiert.

Code:

---

Private Sub CommandButton1_Click()
'Stückliste

Dim LetzteZeile        As Integer
Dim sht                As Worksheet
Dim sNameNewWorksheet  As String
Dim wAktivWorkbook      As Workbooks
Dim i                  As Integer
Dim e                  As Integer
Dim sQuellsht          As String
Dim sNameOldWorksheet  As String

sNameNewWorksheet = "Stückliste_neu"
sQuellsht = "Stuecklistenrelevant"
sQuellsht = "Stuecklistenrelevant"

For Each sht In Worksheets
    If sht.Name = sNameNewWorksheet Then
        'MsgBox "Tabellenblatt vorhanden"
        Worksheets(sNameNewWorksheet).Delete
        MsgBox sNameNewWorksheet & " wurde gelöscht und wird neu generiert!"
        Exit For
    End If
Next

Worksheets.Add.Move after:=Worksheets(Worksheets.Count) 'Tabellenblatt an letzter Stelle einfügen
ActiveSheet.Name = sNameNewWorksheet 'Tabellenblatt unbenennen
Worksheets("Stuecklistenrelevant").Activate 'Tabellenblatt Stuecklistenrelevant aktivieren

LetzteZeile = Cells.Find("*", searchdirection:=xlPrevious).Row 'Letzte Zeile finden
LetzteZeile = LetzteZeile + 2 'Letzte Zeile plus 2

    For Each sht In ActiveWorkbook.Worksheets

     
            If sht.Name = sNameNewWorksheet Then
                'nichts, da dies deine Zieltabelle ist
                If sht.Name = sNameOldWorksheet Then
                    'nichts, da dies deine Zieltabelle ist
                    Else
                        i = 8
                        e = 7
                        Do Until i = LetzteZeile
                        Sheets(sNameNewWorksheet).Range("E1") = Sheets(sQuellsht).Range("E4") 'Kopfwerte kopieren
                        Sheets(sNameNewWorksheet).Range("H2") = Sheets(sQuellsht).Range("G4") 'Kopfwerte kopieren
                   
                        Sheets(sNameNewWorksheet).Range("B" & i) = Sheets(sQuellsht).Range("B" & e) 'Zellen kopieren
                        Sheets(sNameNewWorksheet).Range("C" & i) = Sheets(sQuellsht).Range("E" & e)
                        Sheets(sNameNewWorksheet).Range("D" & i) = Sheets(sQuellsht).Range("C" & e)
                        Sheets(sNameNewWorksheet).Range("E" & i) = Sheets(sQuellsht).Range("H" & e)
                        Sheets(sNameNewWorksheet).Range("F" & i) = Sheets(sQuellsht).Range("D" & e)
                        Sheets(sNameNewWorksheet).Range("G" & i) = Sheets(sQuellsht).Range("J" & e)
                        Sheets(sNameNewWorksheet).Range("H" & i) = Sheets(sQuellsht).Range("G" & e)
                        Sheets(sNameNewWorksheet).Range("I" & i) = Sheets(sQuellsht).Range("I" & e)
                        Sheets(sNameNewWorksheet).Range("K" & i) = Sheets(sQuellsht).Range("K" & e)
       
                        i = i + 1
                        e = e + 1
       
                        Loop
                End If
            End If
    Next
   
Worksheets(sNameNewWorksheet).Activate
Worksheets(sNameNewWorksheet).Columns.AutoFit
Worksheets(sNameNewWorksheet).Range("A1").Select

End Sub

---

Danke schonmal für Euren Hirnschmalz.  

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

mir fällt grad nix besseres ein als eine schleife

Code:

---

Sub test()
'Sheets(sNameNewWorksheet).Range("H2") = Sheets(sQuellsht).Range("G4") 'Kopfwerte kopieren

txt = Sheets(sQuellsht).Range("B" & e)
txt = "77777w1234"   'teststring

For ii = 1 To Len(txt)
    If Not IsNumeric(Mid(txt, ii, 1)) Then  'prüfe ob keine Zahl
       newString = newString & Mid(txt, ii, 99)  'Sheets(sNameNewWorksheet).Range("B" & i) =
       ii = Len(txt)
    End If
Next

Sheets(sNameNewWorksheet).Range("B" & i) = newString

'Sheets(sNameNewWorksheet).Range("C" & i) = Sheets(sQuellsht).Range("E" & e)

End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Uwe,

Code:

---

Sub Entfernen()
  Dim lngZeile As Long
  Dim strWert As String
  For lngZeile = 1 To 10  '<== Zeilenanzahl anpassen
      If IsNumeric(Left(Cells(lngZeile, 2), 1)) Then
        strWert = Val(Cells(lngZeile, 2))
        Cells(lngZeile, 2) = Mid(Cells(lngZeile, 2), Len(strWert) + 1)
      End If
  Next lngZeile
End Sub

---

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ungefragt, aber möglich und viiiiiiiiiiiiiiiel kürzer  : Ohne Makro, wenn Textlänge immer gleich

=RECHTS(DeinText;4)

------------------
DIN1055.de  |  Lastannahmen für Anwender

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo ihr drei, 

habe mir die Variante von Thomas eingebaut.

Diese habe ich am besten nachvollziehen können.

@Paulchen. Danke auch für deinen Denkanstoß. Ich musste das ganze in mein Makro einbauen.

Danke nochmal.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP