Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

RegExp oder andere Möglichkeit

Forumthread: RegExp oder andere Möglichkeit

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

Anzeige

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

Betreff
Datum
Anwender
Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
funktioniert einwandfrei, Herzlichen Dank, oT
22.04.2013 16:19:03
mehmet
.
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige