markiere bestimmte Strings

Forumthread: markiere bestimmte Strings

15.03.2009 22:49:33

mehmet

Hallo Forum,
ich würde gern bestimmte Strings in Spalte C3:C100 markieren:
Z.Z. steht in C5:
SDGF DFGR54 56ERG 12315KT 123SDF54 SDFF123FR 56195KT DF55210KT 95465KT FGFD654
Die Markierungen sollen so identifiziert werden:
3Zahlen+2Zahlen+KT
Markiert sollen 3Zahlen immer in schwarz schrift und
markiert sollen 2Zahlen+KT, wenn 2Zahlen 20 bis 30 in blau+fett und wenn 2Zahlen 31 bis 80 in rot+fett.
Danke im voraus
Gruß
mehmet

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: markiere bestimmte Strings

15.03.2009 23:38:18

Josef

Hallo Mehmet,
das lässt sich doch ganz einfach in den vorherigen Code integrieren.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub colorText()
  Dim rng As Range, rngF As Range
  Dim intPos As Integer

  With Range("C3:C100")
    On Error Resume Next
    Set rng = .SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    .Font.ColorIndex = xlAutomatic
    .Font.Bold = False
  End With

  If Not rng Is Nothing Then
    For Each rngF In rng
      intPos = InStr(1, rngF.Text, "BKN")
      Do While intPos > 0
        If IsNumeric(Mid(rngF.Text, intPos + 3, 3)) Then
          If Cint(Mid(rngF.Text, intPos + 3, 3)) < 3 Then
            rngF.Characters(intPos, 6).Font.ColorIndex = 3
          ElseIf Cint(Mid(rngF.Text, intPos + 3, 3)) < 6 Then
            rngF.Characters(intPos, 6).Font.ColorIndex = 5
          End If
        End If
        intPos = InStr(intPos + 1, rngF.Text, "BKN")
      Loop
      intPos = InStr(1, rngF.Text, "KT")
      Do While intPos > 0
        If IsNumeric(Mid(rngF.Text, intPos - 2, 2)) And Mid(rngF.Text, intPos - 6, 1) = " " Then
          rngF.Characters(intPos - 5, 7).Font.Bold = True
          If Cint(Mid(rngF.Text, intPos - 2, 2)) >= 20 And Cint(Mid(rngF.Text, intPos - 2, 2)) <= 30 Then
            rngF.Characters(intPos - 2, 4).Font.ColorIndex = 5
          ElseIf Cint(Mid(rngF.Text, intPos - 2, 2)) > 30 And Cint(Mid(rngF.Text, intPos - 2, 2)) <= 81 Then
            rngF.Characters(intPos - 2, 4).Font.ColorIndex = 3
          End If
        End If
        intPos = InStr(intPos + 1, rngF.Text, "KT")
      Loop
    Next
  End If

  Set rng = Nothing
End Sub

Gruß Sepp

AW: markiere bestimmte Strings

15.03.2009 23:46:02

mehmet

Super Sepp,
herzlichen Dank.
Ich werde jetzt versuchen, die Zeilen zu Kommentieren zwecks Verständnis
Angenehme Nacht.
Gruß
mehmet

AW: markiere bestimmte Strings

15.03.2009 23:51:03

mehmet

Hallo Sepp,
sorry ich nochmal
kann man das vorherige (BKN) mit dem (KT) nicht voneinander trennen.
So wird es zu kompliziert für mich 8-) sorry
Gruß
mehmet

AW: markiere bestimmte Strings

15.03.2009 23:52:11

mehmet

So dass KT eine eigene Makro ist

AW: markiere bestimmte Strings

16.03.2009 00:08:08

Josef

Hallo Mehmet,
kein Prob lem.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub colorTextBKN()
  Dim rng As Range, rngF As Range
  Dim intPos As Integer

  With Range("C3:C100")
    On Error Resume Next
    Set rng = .SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    .Font.ColorIndex = xlAutomatic
    .Font.Bold = False
  End With

  If Not rng Is Nothing Then
    For Each rngF In rng
      intPos = InStr(1, rngF.Text, "BKN")
      Do While intPos > 0
        If IsNumeric(Mid(rngF.Text, intPos + 3, 3)) Then
          If Cint(Mid(rngF.Text, intPos + 3, 3)) < 3 Then
            rngF.Characters(intPos, 6).Font.ColorIndex = 3
          ElseIf Cint(Mid(rngF.Text, intPos + 3, 3)) < 6 Then
            rngF.Characters(intPos, 6).Font.ColorIndex = 5
          End If
        End If
        intPos = InStr(intPos + 1, rngF.Text, "BKN")
      Loop
    Next
  End If

  Set rng = Nothing
End Sub

Sub colorTextKT()
  Dim rng As Range, rngF As Range
  Dim intPos As Integer

  With Range("C3:C100")
    On Error Resume Next
    Set rng = .SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    .Font.ColorIndex = xlAutomatic
    .Font.Bold = False
  End With

  If Not rng Is Nothing Then
    For Each rngF In rng
      intPos = InStr(1, rngF.Text, "KT")
      Do While intPos > 0
        If IsNumeric(Mid(rngF.Text, intPos - 2, 2)) And Mid(rngF.Text, intPos - 6, 1) = " " Then
          rngF.Characters(intPos - 5, 7).Font.Bold = True
          If Cint(Mid(rngF.Text, intPos - 2, 2)) >= 20 And Cint(Mid(rngF.Text, intPos - 2, 2)) <= 30 Then
            rngF.Characters(intPos - 2, 4).Font.ColorIndex = 5
          ElseIf Cint(Mid(rngF.Text, intPos - 2, 2)) > 30 And Cint(Mid(rngF.Text, intPos - 2, 2)) <= 81 Then
            rngF.Characters(intPos - 2, 4).Font.ColorIndex = 3
          End If
        End If
        intPos = InStr(intPos + 1, rngF.Text, "KT")
      Loop
    Next
  End If

  Set rng = Nothing
End Sub

Gruß Sepp

AW: markiere bestimmte Strings

16.03.2009 00:15:01

mehmet

Herzlichen Dank Sepp.
Jetzt bin ich dran 8-)
mfG
mehmet

AW: markiere bestimmte Strings

16.03.2009 00:12:18

Tino

Hallo,
hier noch eine Version

Option Explicit

Public Sub InStrZahlen(ByVal strString$, objMatch As Object)
Dim Regex As Object
Set Regex = CreateObject("Vbscript.Regexp")
With Regex
    .IgnoreCase = False
    .MultiLine = True
    .Pattern = " \d{5,5}KT "
    .Global = True
     Set objMatch = .Execute(strString)
End With
Set Regex = Nothing
End Sub

Sub TextHervorheben()
Dim Zelle As Range
Dim objMatch As Object
Dim iIndex As Integer
Dim iColor As Integer

Application.ScreenUpdating = False

    For Each Zelle In Range("C3:C100") 'Zellbereich angeben 
        
        With Zelle.Font
         .ColorIndex = 0
         .Bold = False
        End With
        
        InStrZahlen Zelle.Text, objMatch
          
        For iIndex = 0 To objMatch.Count - 1
            
            Select Case intIndex
             Case 0: iColor = 1
             Case 1: iColor = 3
             Case 2: iColor = 5
            End Select
         
            With Zelle.Characters(objMatch(iIndex).FirstIndex + 2, 7).Font
             .ColorIndex = iColor
             .Bold = True
            End With
        
        Next iIndex
      Set objMatch = Nothing
    Next Zelle
    
Application.ScreenUpdating = True
End Sub

Gruß Tino

AW: markiere bestimmte Strings

16.03.2009 00:19:50

mehmet

Hallo Tino,
Dank Dir für deine Mühe.
Ich habe mal ein Makro laufen lassen.
Der bleibt an der Stelle:


Select Case intIndex

mit Markierung auf intIndex und als Msgbox



Variable nicht definiert

Gruß
mehmet

AW: markiere bestimmte Strings

16.03.2009 00:22:00

mehmet

ok Tino, ich hab es 8-)
Ich habe es als iIndex korrigiert.
Jetzt geht es.
Dank Dir
Gruß
mehmet

AW: markiere bestimmte Strings

16.03.2009 00:22:17

Tino

Hallo,
sorry hatte den Code nach dem aufräumen nicht mehr getestet.
So gehts.

Option Explicit

Public Sub InStrZahlen(ByVal strString$, objMatch As Object)
Dim Regex As Object
Set Regex = CreateObject("Vbscript.Regexp")
With Regex
    .IgnoreCase = False
    .MultiLine = True
    .Pattern = " \d{5,5}KT "
    .Global = True
     Set objMatch = .Execute(strString)
End With
Set Regex = Nothing
End Sub

Sub TextHervorheben()
Dim Zelle As Range
Dim objMatch As Object
Dim iIndex As Integer
Dim iColor As Integer

Application.ScreenUpdating = False

    For Each Zelle In Range("C3:C100") 'Zellbereich angeben 
        
        With Zelle.Font
         .ColorIndex = 0
         .Bold = False
        End With
        
        InStrZahlen Zelle.Text, objMatch
          
        For iIndex = 0 To objMatch.Count - 1
            
            Select Case iIndex
             Case 0: iColor = 1
             Case 1: iColor = 3
             Case 2: iColor = 5
            End Select
         
            With Zelle.Characters(objMatch(iIndex).FirstIndex + 2, 7).Font
             .ColorIndex = iColor
             .Bold = True
            End With
        
        Next iIndex
      Set objMatch = Nothing
    Next Zelle
    
Application.ScreenUpdating = True
End Sub

Gruß Tino

AW: markiere bestimmte Strings

16.03.2009 00:24:47

mehmet

Hat sich wohl geschnitten 8-)
Jetzt läuft es aber garantiert.
Dank Dir
Gruß
mehmet

Beliebteste Forumthreads (12 Monate)

Forumthread: markiere bestimmte Strings

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread