Thema Datum  Von Nutzer Rating
Antwort
01.02.2017 10:11:08 excelboy33
Solved
01.02.2017 19:11:01 SJ
NotSolved
06.02.2017 11:10:27 excelboy33
NotSolved
06.02.2017 13:20:13 SJ
NotSolved
06.02.2017 15:28:59 excelboy33
NotSolved
07.02.2017 08:15:47 SJ
*****
NotSolved
07.02.2017 08:33:55 excelboy33
NotSolved
07.02.2017 08:40:14 SJ
NotSolved
07.02.2017 09:03:28 excelboy33
NotSolved
07.02.2017 09:44:53 excelboy33
NotSolved
07.02.2017 09:59:14 SJ
NotSolved
07.02.2017 10:11:33 excelboy33
NotSolved
07.02.2017 10:15:21 SJ
NotSolved
07.02.2017 10:24:38 excelboy33
NotSolved
07.02.2017 10:27:10 SJ
NotSolved
07.02.2017 10:31:01 excelboy33
NotSolved
07.02.2017 10:40:40 SJ
NotSolved
07.02.2017 12:31:25 Gast71535
NotSolved
07.02.2017 12:31:42 excelboy33
NotSolved
07.02.2017 13:00:17 SJ
NotSolved
14.02.2017 09:29:26 excelboy33
NotSolved
14.02.2017 09:41:44 excelboy33
NotSolved
14.02.2017 10:06:26 SJ
NotSolved
14.02.2017 12:57:54 excelboy33
NotSolved
14.02.2017 13:12:02 SJ
NotSolved
13.03.2017 10:05:30 excelboy33
NotSolved
Rot Trimm Funktion (besonders an SJ)
13.03.2017 10:13:53 SJ
NotSolved
13.03.2017 12:19:02 excelboy33
NotSolved
13.03.2017 12:27:31 SJ
NotSolved

Ansicht des Beitrags:
Von:
SJ
Datum:
13.03.2017 10:13:53
Views:
568
Rating: Antwort:
  Ja
Thema:
Trimm Funktion (besonders an SJ)

Hallo,

super umgesetzt ;)

Die Sortierung könntest du durch die Nutzung des Index umsetzen. Du müsstest also noch folgendes hinzufügen:

Option Explicit

Public Sub suchen_und_kopieren()
    Dim strSQL As String
    strSQL = get_sql_string
  
    Dim regEx As New RegExp
    With regEx
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
        .Pattern = "PPD(?!_)[A-Z;a-z;0-9]+"
    End With
      
    Dim colMatches As MatchCollection
    Dim m As Match
      
    Set colMatches = regEx.Execute(strSQL)
  
    If colMatches.Count = 0 Then
        GoTo clean_up
    End If
    
    'Neue Variable für letzte Zeile
    Dim l As Long
    For Each m In colMatches
        With Worksheets("Tabelle2")
            'Letzte Zeile ermitteln
            l = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            'Erste Spalte Index
            .Cells(l, 1) = m.FirstIndex
            'Zweite Spalte Wert
            .Cells(l, 2) = Right(m.Value, 10)
        End With
    Next m
 
clean_up:
    If Not colMatches Is Nothing Then Set colMatches = Nothing
    If Not regEx Is Nothing Then Set regEx = Nothing
End Sub

Ist soweit ungetestet, über Rückmeldung würde ich mich freuen.

Gruß


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
01.02.2017 10:11:08 excelboy33
Solved
01.02.2017 19:11:01 SJ
NotSolved
06.02.2017 11:10:27 excelboy33
NotSolved
06.02.2017 13:20:13 SJ
NotSolved
06.02.2017 15:28:59 excelboy33
NotSolved
07.02.2017 08:15:47 SJ
*****
NotSolved
07.02.2017 08:33:55 excelboy33
NotSolved
07.02.2017 08:40:14 SJ
NotSolved
07.02.2017 09:03:28 excelboy33
NotSolved
07.02.2017 09:44:53 excelboy33
NotSolved
07.02.2017 09:59:14 SJ
NotSolved
07.02.2017 10:11:33 excelboy33
NotSolved
07.02.2017 10:15:21 SJ
NotSolved
07.02.2017 10:24:38 excelboy33
NotSolved
07.02.2017 10:27:10 SJ
NotSolved
07.02.2017 10:31:01 excelboy33
NotSolved
07.02.2017 10:40:40 SJ
NotSolved
07.02.2017 12:31:25 Gast71535
NotSolved
07.02.2017 12:31:42 excelboy33
NotSolved
07.02.2017 13:00:17 SJ
NotSolved
14.02.2017 09:29:26 excelboy33
NotSolved
14.02.2017 09:41:44 excelboy33
NotSolved
14.02.2017 10:06:26 SJ
NotSolved
14.02.2017 12:57:54 excelboy33
NotSolved
14.02.2017 13:12:02 SJ
NotSolved
13.03.2017 10:05:30 excelboy33
NotSolved
Rot Trimm Funktion (besonders an SJ)
13.03.2017 10:13:53 SJ
NotSolved
13.03.2017 12:19:02 excelboy33
NotSolved
13.03.2017 12:27:31 SJ
NotSolved