Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 16:39:00
ältere VBA Codes automatisch neu strukturieren
20.04.2024 16:36:42
Arbeitsblatt Script auslagern in Modul
20.04.2024 16:28:25
zwei Makro in einem zusammenführen?
20.04.2024 15:30:14
Warum Verweis zeigt Falsch an
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1060to1064
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
1060to1064
1060to1064
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

markiere bestimmte Strings

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

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

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

Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
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)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige