Text (Textmuster) Suche

Hallo ihr hellen Köpfe,
folgende Problemstellung, die ich leider nur mit einer unbefriedigenden Laufzeit lösen konnte.
Ich versuche mal das Problem so minimalistisch wie möglich zu beschreiben. Ich habe einen großen Datensatz, in dem es eine Spalte gibt, die mit Freitext von Hand ausgefüllt wurde. Diese Texte enthalten zumeist mehrere 'Fehlercodes' nach einem der folgenden Muster (# steht für eine Ziffer; X für einen Buchstaben; _ für ein Leerzeichen)
P_###X
P###X
P_####
P####
Ich wollte nun eine Abfrage schreiben, die mir aus diesen Texten alle Codes die diesem Muster entsprechen herauszieht und auflistet. (Folgendes Muster: Spalte mit Text, dahinter 10 Spalten mit den gefundenen Treffern, mehr als zehn sind es nie)
Ich habe eine Version geschrieben, in der er die Datenbank mit allen Codes (etwa 1000) durchläuft und das für jedes der Textfelder. Diese Abfrage dauert aber leider eine gute halbe Stunde aufgrund der Datenmengen, daher wäre eine Abfrage nach dem Muster und ein späterer Check wesentlich effizienter.
Gibt es eine Möglichkeit so etwas in VBA zu schreiben, oder besser gesagt, kennt jmd eine, die Existenz steht vermutlich nicht zur Debatte. Jedenfalls bin ich an die Grenzen meines Wissens und meiner Literatur gestoßen und würde daher gerne auf das gesammelte Wissen der Forumsteilnehmer zurück greifen.
Vielen Dank schonmal für Eure Mühen.
Mit den besten Grüßen
Christoph

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub x() Dim i As Long Dim objRe As Object Set objRe = CreateObject("vbscript.regexp") objRe.Pattern = ".*?P\d\d\d[A-Z0-9]" For i = 1 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 Cells(i, 2).Value = objRe.Test(Cells(i, 1).Value) Next Set objRe = Nothing End Sub

Nachtrag,
das ist wohl nicht so meine Woche ;-)
Ein regulärer Ausdruck durchsucht immer den gesamten String von links nach rechts auf einen möglichen Treffer. D.h. solange Du keinen Anker auf den 'Zeilenanfang' setzt (via ^) kannst Du Dir das ".*?" am Anfang sparen. Dann bleibt hier aber nur noch der gesuchte Ausdruck selber übrig...
D.h. Du brauchst hier keine SubMatches, objMc(0) liefert den 'gesamten passenden Treffer' sowieso schon zurück...
HTH, Bernd
--

Option Explicit

Sub x2()
    Dim i As Long
    Dim objRe As Object
    Dim objMc As Object

    Set objRe = CreateObject("vbscript.regexp")
    objRe.Pattern = "P\d\d\d[A-Z0-9]"
    For i = 1 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
        Set objMc = objRe.Execute(Cells(i, 1).Value)
        If objMc.Count Then
            Cells(i, 2).Value = objMc(0)
        Else
            Cells(i, 2).Value = "no match"
        End If
    Next
    Set objMc = Nothing
    Set objRe = Nothing
End Sub

Sub Schaltfläche3_BeiKlick() Dim i As Long Dim objRe As Object Dim objMc As Object Set objRe = CreateObject("vbscript.regexp") objRe.Pattern = "P *\w*\w*\w*\w*" For i = 1 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 Set objMc = objRe.Execute(Cells(i, 1).Value) If objMc.Count Then Cells(i, 2).Value = objMc(0) Else Cells(i, 2).Value = "no match" End If Next Set objMc = Nothing Set objRe = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread