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
Blau Trimm Funktion (besonders an SJ)
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
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:
07.02.2017 08:15:47
Views:
621
Rating: Antwort:
  Ja
Thema:
Trimm Funktion (besonders an SJ)

Guten Morgen,

den ersten Teil habe ich hinbekommen:

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 = True
        .MultiLine = True
        .Pattern = "PPD\d\d\d\d\d\d"
    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, 6)
        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

Für den zweiten Teil müsstest du oder jemand anderes aus dem Forum sich eine sehr clevere Idee einfallen lassen, wie man an die einzelnen Tabellennamen kommt. Am einfachsten wäre es wohl eine Collection aller vorhandenen Tabellennahmen zu erstellen und dann zu prüfen, ob diese in dem SQL Statement vorkommen.

Viele Grüße


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