Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
24.04.2024 14:40:10
Zeilenumbrüche in Textbox zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1308to1312
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1308to1312
1308to1312
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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

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
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige