Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
320to324
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
320to324
320to324
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Stringauswahl - dringend

Stringauswahl - dringend
09.10.2003 07:20:02
Paul
Guten Morgen !

Ich habe ein sehr dringendes Problem, wofür ich ein
Makro suche.

Folgendes steht in Spalte A als String:
az=TlR10H31G25 na= Walter Bau u.s.w.
az=TlR10H31G8 na= Walter Bau 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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Stringauswahl - dringend
09.10.2003 08:02:14
WernerB.
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).
Anzeige
AW: Stringauswahl - dringend
09.10.2003 08:06:33
Paul
Hallo Werner !

Danke. Werde es probieren und mich melden.

Gruss
Paul
AW: Stringauswahl - dringend
09.10.2003 08:06:41
Willie
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

AW: Stringauswahl - dringend
09.10.2003 08:45:11
Paul
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
Anzeige
AW: Stringauswahl - dringend
09.10.2003 08:55:30
WernerB.
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.
Anzeige
AW: Stringauswahl - dringend
09.10.2003 09:15:05
Paul
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
AW: Stringauswahl - dringend
09.10.2003 09:39:01
Paul
Hallo Werner !

Nochmals zur Fehlermeldung.

Es ist scheinbar ein Überlauf !

Gruss
Paul
AW: Stringauswahl - dringend
09.10.2003 14:59:56
WernerB.
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.
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige