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
Blau Trimm Funktion (besonders an SJ)
13.03.2017 10:05:30 excelboy33
NotSolved
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:
excelboy33
Datum:
13.03.2017 10:05:30
Views:
576
Rating: Antwort:
  Ja
Thema:
Trimm Funktion (besonders an SJ)

Hallo nochmal!

 

dank deinem code und der seite RegExr konnte ich meine gewünschten zeilen alle finden :)

Option Explicit


'YES kopiert alle PPD id's in Tabelle2


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
 
    For Each m In colMatches
        With Worksheets("Tabelle2")
            .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) = 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
 
Private Function get_sql_string() As String
    Dim l As Long, k As Long
    Dim s As String
     
    With Worksheets("Tabelle1")
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        For l = 1 To k
            s = s & .Cells(l, 1)
        Next l
    End With
     
    get_sql_string = s
End Function

und mit diesem code habe ich geschafft die richtigen froms zu kopieren :


Option Explicit


'YES kopiert alle FROM in Tabelle2


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 = "FROM\s+(?!POSITION)(?!AND)\D[_-z;.-9;A-Z]+"                
    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
 
    For Each m In colMatches
        With Worksheets("Tabelle2")
            .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) = Left(m.Value, 50)
        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
 
Private Function get_sql_string() As String
    Dim l As Long, k As Long
    Dim s As String
     
    With Worksheets("Tabelle1")
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        For l = 1 To k
            s = s & .Cells(l, 1)
        Next l
    End With
     
    get_sql_string = s
End Function


Wie schaffe ich es nun, die beiden codes so zusammen zu führen, dass das ergebnis ca folgender maßen aussieht:

ppd123456
from blablabla
from blabla

ppd32424
from xyzxyz
from abcabc

also es soll im query schritt für schritt suchen, sobald eine ppd gefunden wird kopieren und sobald ein from gefunden wird diese kopieren und nicht erst alle ppds und danach alle froms :)
Ich hoffe ich konnte mich halbwegs gut ausdrücken; vielen dank im vorraus :)

 


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
Blau Trimm Funktion (besonders an SJ)
13.03.2017 10:05:30 excelboy33
NotSolved
13.03.2017 10:13:53 SJ
NotSolved
13.03.2017 12:19:02 excelboy33
NotSolved
13.03.2017 12:27:31 SJ
NotSolved