u.s.w.
Nun benötige ich aber n u r die letzten Zeichen ab G des Teilstrings.
In diesem Beispiel wäre dies G25 oder G8. Alle Angabe sind durch ein Leer-
zeichen getrennt.
Wenn diese Zeichen auf ein gesondertes Tabellenblatt gingen und dabei
noch die Doppelten herausgenommen würder, wäre das das Absolute.
Gruss
Paul
Betrifft: AW: Stringauswahl - dringend
von: WernerB.
Geschrieben am: 09.10.2003 08:02:14
Hallo Paul,
was hältst Du hiervon:
Option Explicit
Sub Paul()
Dim BlaNa As String, Tx As String
Dim laR As Long, i As Long, j As Long
Dim Lae As Byte
Application.ScreenUpdating = False
BlaNa = ActiveSheet.Name
laR = Cells(Rows.Count, 1).End(xlUp).Row
Sheets.Add after:=Sheets(Sheets.Count)
With Sheets(BlaNa)
For i = 1 To laR
Lae = InStr(.Cells(i, 1).Text, " ")
If Lae > 0 Then
Tx = Mid(.Cells(i, 1).Text, 12, Lae - 12)
Cells(i, 1).Value = Tx
End If
Next i
End With
Range("A1:A" & laR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
For j = laR To 2 Step -1
If Cells(j, 1).Value = Cells(j - 1, 1).Value Then Rows(j).Delete Shift:=xlUp
Next j
Application.ScreenUpdating = True
End Sub
Viel Erfolg wünscht
WernerB.
P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).
Betrifft: AW: Stringauswahl - dringend
von: Paul
Geschrieben am: 09.10.2003 08:06:33
Hallo Werner !
Danke. Werde es probieren und mich melden.
Gruss
Paul
Betrifft: AW: Stringauswahl - dringend
von: Willie
Geschrieben am: 09.10.2003 08:06:41
mit der Funkton Teil kannst du es machen. Doppelte löschen
findest du viele Beispiele in der Recherche!
Gruß
Willie
=TEIL(A1;12;100)
oder als VBA
Sub TeilvonSpalteA ()
For i = 1 To 100
Cells(i, 2).Activate
ActiveCell.FormulaR1C1 = "=MID(RC[-1],12,100)"
Next
End Sub
Betrifft: AW: Stringauswahl - dringend
von: Paul
Geschrieben am: 09.10.2003 08:45:11
Servus !
Habe jetzt probiert. Funktioniert, aber ..
Hatte vergessen, dass in Spalte A der String
auch folgend aussehen kann:
az=TlR10H31G25 na= Walter Bau u.s.w.
az=TlR10H31G8 na= Walter Bau u.s.w.
az=TlR9H31G8 na= Walter Bau u.s.w.
az=TlR105H31G101 na= Walter Bau u.s.w.
D.h. der Teilstring z.B. "TIR....G8" hat auch unterschiedliche
längen !
Auf Hilfe hoffent
Paul
Betrifft: AW: Stringauswahl - dringend
von: WernerB.
Geschrieben am: 09.10.2003 08:55:30
Hallo Paul,
dann eben so:
Option Explicit
Sub Paul()
Dim BlaNa As String, Tx As String
Dim laR As Long, i As Long, j As Long
Dim Lae1 As Byte, Lae2 As Byte
Application.ScreenUpdating = False
BlaNa = ActiveSheet.Name
laR = Cells(Rows.Count, 1).End(xlUp).Row
Sheets.Add after:=Sheets(Sheets.Count)
With Sheets(BlaNa)
For i = 1 To laR
Lae1 = InStr(.Cells(i, 1).Text, "G")
Lae2 = InStr(.Cells(i, 1).Text, " ")
If Lae2 > 0 Then
Tx = Mid(.Cells(i, 1).Text, Lae1, Lae2 - Lae1)
Cells(i, 1).Value = Tx
End If
Next i
End With
Range("A1:A" & laR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
For j = laR To 2 Step -1
If Cells(j, 1).Value = Cells(j - 1, 1).Value Then Rows(j).Delete Shift:=xlUp
Next j
Application.ScreenUpdating = True
End Sub
Gruß WernerB.
Betrifft: AW: Stringauswahl - dringend
von: Paul
Geschrieben am: 09.10.2003 09:15:05
Hallo Werner !
Funktioniert im Großen gut.
Ich kriege aber eine Fehlermeldung wie folgt:
For i = 1 To laR
Lae1 = InStr(.Cells(i, 1).Text, "G")
Lae2 = InStr(.Cells(i, 1).Text, " ")
If Lae2 > 0 Then
Tx = Mid(.Cells(i, 1).Text, Lae1, Lae2 - Lae1) << hier bleibt Debugger stehen.
Cells(i, 1).Value = Tx
End If
Next i
Gruss
Paul
Betrifft: AW: Stringauswahl - dringend
von: Paul
Geschrieben am: 09.10.2003 09:39:01
Hallo Werner !
Nochmals zur Fehlermeldung.
Es ist scheinbar ein Überlauf !
Gruss
Paul
Betrifft: AW: Stringauswahl - dringend
von: WernerB.
Geschrieben am: 09.10.2003 14:59:56
Hallo Paul,
wenn das Makro immer noch nicht so läuft, wie es soll, dann lade doch Deine Datei (nur die relevante Datenursprungs-Seite) hier hoch; dann kann ich mich damit befassen. Ansonsten stochere ich nur im Nebel, weil ich den von Dir geschilderten Hänger sonst nicht nachvollziehen kann.
Nur so kann ich den Fehler analysieren und ihn ggf. zu beheben versuchen.
Gruß WernerB.