RegExp oder andere Möglichkeit

Forumthread: RegExp oder andere Möglichkeit

21.04.2013 20:17:01

mehmet

Hallo lieber Forum,
ich habe ein RegExp Macro vorliegen, wollte es modifizieren jedoch ohne Erfolg.
Hier das Problem:
In Tabelle1 werden gelegendlich Daten importiert, i.d.R. A6:A600.
Es soll in Tabelle1 A6:A600 nach folgende Kriterien gesucht und markiert werden.
Alle Strings, die folgende Zeichen hintereinander haben:
Zahl Zahl Zahl Zahl Zahl Buchstabe (ist immer ein G) Zahl Zahl Buchstabe Buchstabe (ist immer KT)
Also so z.B. in Zelle A6: TEMPO 2212/2218 34017G36KT
Es sollen, die hier fett gekennzeichnet sind, markiert werden.
17G, die Zellformatierung von Sheet1 N16 (weil Wert zwischen 10-28 ist).
36KT, die Zellformatierung von Sheet1 N31 (weil Wert zwischen 35-40 ist).
Ich hoffe, dass ich mich verständlich ausdrücken konnte.
Herzlichen Dank im Voraus
Gruss
mehmet
Als Anlage ein Versuch: https://www.herber.de/bbs/user/84973.xls

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: RegExp oder andere Möglichkeit

21.04.2013 21:41:14

CitizenX
Nachtrag zu RegExp

21.04.2013 21:55:59

CitizenX
AW: Nachtrag zu RegExp

22.04.2013 05:01:34

mehmet
AW: Nachtrag zu RegExp

22.04.2013 10:42:07

CitizenX
funktioniert einwandfrei, Herzlichen Dank, oT

22.04.2013 16:19:03

mehmet

AW: RegExp oder andere Möglichkeit

21.04.2013 21:41:14

CitizenX

Hi,
hier mal als Bsp für G-Werte:
Private Sub MarkiereMir_G_An()
Dim Bereich As Range, rngCell As Range
Dim objRegEx As Object, objMatch As Object
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
    .IgnoreCase = False 'Groß u. Kleinschreibung nicht beachten, sonst False
    .Pattern = "(\d{2})(?=G)" 'od (\d{2})(?=KT)
End With
Set Bereich = Range("a6:a600") 'Suchbereich
Application.ScreenUpdating = False
For Each rngCell In Bereich
    Set objMatch = objRegEx.Execute(rngCell.Value)
    If objMatch.Count Then
       With rngCell.Characters(objMatch(i).FirstIndex + 1, Len(objMatch(i)))
        Select Case objMatch(i) * 1
        Case 0 To Worksheets("Sheet1").Range("n16").Value
            .Font.Bold = Worksheets("Sheet1").Range("n16").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n16").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n16").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n16").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n16").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n16").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n16").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n16").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n17").Value + 1 To Worksheets("Sheet1").Range("n18").Value
            .Font.Bold = Worksheets("Sheet1").Range("n18").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n18").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n18").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n18").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n18").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n18").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n18").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n18").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n16").Value + 1 To Worksheets("Sheet1").Range("n17").Value
            .Font.Bold = Worksheets("Sheet1").Range("n17").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n17").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n17").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n17").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n17").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n17").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n17").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n17").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n17").Value + 1 To Worksheets("Sheet1").Range("n18").Value
            .Font.Bold = Worksheets("Sheet1").Range("n18").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n18").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n18").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n18").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n18").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n18").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n18").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n18").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n18").Value + 1 To Worksheets("Sheet1").Range("n19").Value
            .Font.Bold = Worksheets("Sheet1").Range("n19").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n19").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n19").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n19").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n19").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n19").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n19").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n19").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n19").Value + 1 To Worksheets("Sheet1").Range("n20").Value
            .Font.Bold = Worksheets("Sheet1").Range("n20").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n20").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n20").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n20").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n20").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n20").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n20").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n20").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n20").Value + 1 To Worksheets("Sheet1").Range("n21").Value
            .Font.Bold = Worksheets("Sheet1").Range("n21").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n21").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n21").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n21").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n21").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n21").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n21").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n21").Font.ColorIndex
        Case Worksheets("Sheet1").Range("n21").Value + 1 To Worksheets("Sheet1").Range("n22").Value
            .Font.Bold = Worksheets("Sheet1").Range("n22").Font.Bold
            .Font.Strikethrough = Worksheets("Sheet1").Range("n22").Font.Strikethrough
            .Font.Superscript = Worksheets("Sheet1").Range("n22").Font.Superscript
            .Font.Name = Worksheets("Sheet1").Range("n22").Font.Name
            .Font.Underline = Worksheets("Sheet1").Range("n22").Font.Underline
            .Font.FontStyle = Worksheets("Sheet1").Range("n22").Font.FontStyle
            .Font.Size = Worksheets("Sheet1").Range("n22").Font.Size
            .Font.ColorIndex = Worksheets("Sheet1").Range("n22").Font.ColorIndex
        End Select
    End With
   End If
Next rngCell
Application.ScreenUpdating = True
Set objMatch = Nothing: Set objRegEx = Nothing
End Sub
Grüße
Steffen

Nachtrag zu RegExp

21.04.2013 21:55:59

CitizenX

...bei dem Regex reicht schon:
objRegEx.Pattern = "\d{2}(?=KT)"

anstatt deiner With Anweisung:
With objRegEx
.IgnoreCase = False 'Groß u. Kleinschreibung nicht beachten, sonst False
.MultiLine = True
.Global = True
.Pattern = "[0-9]{2,2}[G]{1,1}|[G]{1,1}[0-9]{2,2}" 'Suchbegriffe durch | trennen
End With
Denn IgnoreCase kannst du dir sparen weil G wohl immer G ist...
MultiLine= True nicht Notwendig ist weil nicht über mehrere Zeilen verglichen wird..
.Global = True nicht Notwendig ist weil es (wenn überhaupt) nur einen Teffer gibt
Grüße Steffen

AW: Nachtrag zu RegExp

22.04.2013 05:01:34

mehmet

Hallo Steffen,
herzlichen Dank für deine Hilfe.
Funktioniert einwandfrei.
Was mache ich denn bei KT, wenn es so heisst:
z.B. Zeile x: TAF LLBG 211005Z 2112/2212 25010KT 9999 SCT030 SCT050
z.B. Zeile y: TEMPO 2209/2212 24015G25KT 7000 RA SCT020 SCT025TCU BKN030 TX19/2211Z TN13/2203Z
z.B. Zeile z: TAF LTBA 211040Z 2112/2218 24012KT 9999 SCT035
zu Zeile x: diese Zeichen sollen nicht formatiert werden (kein G Buchstabe enthalten)
zu Zeile y: diese Zeichen sollen formatiert werden (beinhaltet G)
zu Zeile z: diese Zeichen sollen nicht formatiert werden (kein G dabei)
Ich danke Dir herzlich
Viele Grüsse
mehmet

AW: Nachtrag zu RegExp

22.04.2013 10:42:07

CitizenX

Moin,
Für G:
Private Sub MarkiereMir_G_An()
Dim Bereich As Range, rngCell As Range
Dim objRegEx As Object, objMatch As Object
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "(\d{2})G(\d{2})KT"
Set Bereich = Range("A6:A600") 'Suchbereich
Application.ScreenUpdating = False
For Each rngCell In Bereich
    Set objMatch = objRegEx.Execute(rngCell.Value)
    If objMatch.Count Then
       With rngCell.Characters(objMatch(0).FirstIndex + 1, 2)
        Select Case objMatch(0).submatches(0) * 1
        Case 0 To Worksheets("Sheet1").Range("N16").Value
        '...
        '...
        ' deine weitere Bedingungsabfrage
Für KT:
Private Sub MarkiereMir_KT_An()
Dim Bereich As Range, rngCell As Range
Dim objRegEx As Object, objMatch As Object
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "(\d{2})G(\d{2})KT"
Set Bereich = Range("A6:A600") 'Suchbereich
Application.ScreenUpdating = False
For Each rngCell In Bereich
    Set objMatch = objRegEx.Execute(rngCell.Value)
    If objMatch.Count Then
       With rngCell.Characters(objMatch(0).FirstIndex + 4, 2)
        Select Case objMatch(0).submatches(1) * 1
        Case 0 To Worksheets("Sheet1").Range("N28").Value
        '...
        '...
        '..deine weitere Bedingungsabfrage
Grüße
Steffen

funktioniert einwandfrei, Herzlichen Dank, oT

22.04.2013 16:19:03

mehmet

Beliebteste Forumthreads (12 Monate)

Forumthread: RegExp oder andere Möglichkeit

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread