Stringauswahl - dringend

• Stringauswahl - dringend von Paul vom 09.10.2003 07:20:02
  • AW: Stringauswahl - dringend - von WernerB. am 09.10.2003 08:02:14
    • AW: Stringauswahl - dringend - von Paul am 09.10.2003 08:06:33
  • AW: Stringauswahl - dringend - von Willie am 09.10.2003 08:06:41
    • AW: Stringauswahl - dringend - von Paul am 09.10.2003 08:45:11
      • AW: Stringauswahl - dringend - von WernerB. am 09.10.2003 08:55:30
        • AW: Stringauswahl - dringend - von Paul am 09.10.2003 09:15:05
          • AW: Stringauswahl - dringend - von Paul am 09.10.2003 09:39:01
            • AW: Stringauswahl - dringend - von WernerB. am 09.10.2003 14:59:56

Betrifft: Stringauswahl - dringend
von: Paul
Geschrieben am: 09.10.2003 07:20:02

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

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.

Beiträge aus den Excel-Beispielen zum Thema " Command Bar"