Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Text ab nten Zeichen löschen

Text ab nten Zeichen löschen
09.09.2022 00:08:05
arke
Hallo Leute,
bin Neuling im Sachen VBA und bräuchte eure Hilfe, da ich nicht weiterkomme.
Ich möchte wie im Bild ein kleines Makro, welches immer das letzte DE-... stehen lässt und alles andere rechts danach entfernt. Falls es nur ein DE oder ein Text ist ohne die Ziffern davor, soll dies aus dem Datensatz entfernt werden. Könnt ihr mir hier weiterhelfen?
Falls möglich gerne auch Excel Formeln..
Beispiel
1) 1234_1234_DE-1234_DE1235_DE1236_DA-1234, 0
2) 1234_1234_DE-1234A/B_AB0000 , 0
3) Beliebiger Text
Ziel
1) 1234_1234_DE-1234_DE-1235_DE-1236
2) 1234_1234_DE-1234A/B
3) Soll einfach wegfallen.

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Text auch ändern?
09.09.2022 07:32:37
MCO
Moin, Arke!
In Zeile 1 ist das Ergebnis modifizierter Text, nicht nur einfach abgeschnitten. Wie sind denn da die Vorgaben? Und ist das Trennzeichen dann immer ein underline "_"?
Gruß, MCO
AW: Text auch ändern?
09.09.2022 12:15:24
arke
Moin!
Also es soll immer das letzte DE-.. Mir der Zeichenfolge am Ende sein.
Alles was nicht dazugehört soll weg.
Die Nomenklatur soll so mit der Underline bleiben.
Gruß
AW: Text ab nten Zeichen löschen
09.09.2022 10:12:42
UweD
Hallo
in ein normales Modul

Sub wegDamit()
Dim Sp As Integer, LR As Long, i As Long, Arr, Anz As Integer
Dim TText As String, T1 As String, T2 As String, Rest As String
Sp = 1 'Spalte A
LR = Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
T1 = "DE"
T2 = "_"
For i = 1 To LR
TText = Cells(i, Sp)
Anz = (Len(TText) - Len(Replace(TText, T1, ""))) / Len(T1)
If Anz > 0 Then
Arr = Split(TText, T1)(Anz)
Rest = Split(Arr, T2)(1)
Cells(i, Sp) = Left(TText, Len(TText) - Len(Rest) - 1)
Else
Cells(i, Sp).ClearContents
End If
Next
End Sub
LG UweD
Anzeige
AW: Text ab nten Zeichen löschen
09.09.2022 12:28:08
arke
Hallo UweD!
Danke für den Code, ich weiß nur nicht was ich falsch mache beim Übertragen, da er mir einen Laufzeitfehler '9' anzeigt. Wüsstest du da etwas?
Beste Grüße
AW: Text ab nten Zeichen löschen
09.09.2022 12:55:21
UweD
Welche Zeile des Makros ist dann markiert, wenn der Fehler auftritt?
AW: Text ab nten Zeichen löschen
09.09.2022 13:16:22
arke
Tatsächlich wird keine markiert, deshalb finde ich es komisch.
AW: Text ab nten Zeichen löschen
09.09.2022 13:19:01
UweD
geh mal mit Einzelschritt (F8) durch das Makro
AW: Text ab nten Zeichen löschen
09.09.2022 13:28:29
arke
Ab dem Punkt
Cells(i, Sp)=Left(TText,Len(TText) - Len(Rest) -1)
Kommt der Fehler "Index außerhalb gültigen Bereichs"
AW: Text ab nten Zeichen löschen
09.09.2022 13:16:28
UweD
Hallo
kann es sein, dass in dem Fehlerfall
nach dem Letzten DE KEIN Unterstrich kommt ?
Wenn dem so ist, was soll dann mit dem Text geschehen?

1234_1234_DE-1234_DE-1235_DE-1236-DA-1234, 0

Anzeige
AW: Text ab nten Zeichen löschen
09.09.2022 13:23:54
arke
Genau, es ist nicht immer ein Unterstrich. Es könnte ein Komma sein, ein Bindestrich o.Ä oder auch nur ein Leerzeichen bzw. Nichts. Es soll nach dem letzten DE einfach entfernt/gelöscht werden.
AW: Text ab nten Zeichen löschen
09.09.2022 13:25:47
UweD
Kommt kein Unterstrich mehr nach dem DE kann nichts mehr abgeschnitten werden, also bleibt der Text so wie er ist.

Sub wegDamit()
Dim Sp As Integer, LR As Long, i As Long, Arr, Anz As Integer
Dim TText As String, T1 As String, T2 As String, Rest As String
Sp = 1 'Spalte A
LR = Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
T1 = "DE"
T2 = "_"
For i = 1 To LR
TText = Cells(i, Sp)
'Anzahl der DE
Anz = (Len(TText) - Len(Replace(TText, T1, ""))) / Len(T1)
If Anz > 0 Then
'Text nach dem Letzten DE
Arr = Split(TText, T1)(Anz)
'kommt danach ein Unterstrich zum Abschneiden
If InStr(Arr, T2) > 0 Then
'der Rest nach DE
Rest = Split(Arr, T2)(1)
Cells(i, Sp) = Left(TText, Len(TText) - Len(Rest) - 1)
End If
Else
Cells(i, Sp).ClearContents
End If
Next
End Sub
LG UweD
Anzeige
AW: Text ab nten Zeichen löschen
09.09.2022 12:36:02
Rolf
Hallo
als Formel probier mal
=WENNFEHLER(LINKS(A1;FINDEN("_";A1;VERWEIS(9^9;FINDEN("DE";A1;ZEILE(A$1:A$100))))-1);"")
und nach unten ziehen.
Gruß Rolf
AW: Text ab nten Zeichen löschen
09.09.2022 13:15:38
arke
Hi Rolf,
danke für die Formel! Funktioniert nahezu perfekt, lediglich wenn ich das Format
0000_0000_DE-0A/B, 0 oder 0000_0000_DE-0000, 0
habe, fällt es leider komplett weg, was eigentlich nicht soll.. Falls man das noch irgendwie reinbringen könnte wäre es super, ansonsten vielen lieben Dank!
Gruss
AW: Text ab nten Zeichen löschen
09.09.2022 13:58:19
Rolf
Hallo arke,
so ganz habe ich Dein System noch nicht gecheckt,
meine Formel trennt am ersten Vorkommen eines Unterstrichs, nach dem letzten DE.
Wenn mehrere DE's vorkommen und danach kein Unterstrich mehr, soll der Text dann bis zum letzten DE erhalten bleiben?
Dann probier mal
=WENNFEHLER(LINKS(A1;FINDEN("_";A1&"_";VERWEIS(9^9;FINDEN("DE";A1;ZEILE(A$1:A$100))))-1);"")
Gruß Rolf
Anzeige
AW: Text ab nten Zeichen löschen
09.09.2022 15:42:23
UweD
Hallo nochmal
Nach dem letzten "DE-" wird das erste Trennzeichen verwendet.
Mögliche Trennzeichen _ , - und (Leerzeichen)

Sub wegDamit2()
Dim Sp As Integer, LR As Long, i As Long, Pos As Integer
Dim TText As String, T1 As String, Rest As String
Dim Pmin As Integer, PU As Integer, PM As Integer, PK As Integer, PL As Integer
Sp = 1 'Spalte A
LR = Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
T1 = "DE-"
For i = 1 To LR
TText = Cells(i, Sp)
Pos = InStrRev(TText, T1)
If Pos > 0 Then
Rest = Mid(TText, Pos + Len(T1))
Pmin = Len(Rest)
PU = InStr(Rest, "_"): If PU > 0 And PU  0 And PM  0 And PK  0 And PL  Len(Rest) Then
Cells(i, Sp) = Left(TText, Len(TText) - Len(Rest) + Pmin - 1)
End If
Else
Cells(i, Sp).ClearContents
End If
Next
End Sub
LG UweD
Anzeige

320 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige