Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Position und Länge von Stringeinfärbungen berechnen
#1
Hallo VBA Experten,

ich bräuchte mal Rat, oder besser gesagt etwas VBA Code. Ich habe in meiner Zelle
Strings stehen, die ab einer bestimmten Stelle rot eingefärbt sind. Ich brauche nun
VBA Code der mir ausgibt, ab welcher Stelle die Rotfärbung eintritt und ab wann diese
in der betreffenden Zelle wieder aufhört.

Danke im voraus!
to top
#2
Hallöchen,

probiere es mal damit. Eventuell musst Du den Zahlencode 255 anpassen, falls Du oder Dein Excel ein anderes rot hast als ich :-)

Code:
Sub ColorPosition()
Dim iChar As Integer, strPos As String
With ActiveCell
  Do While iChar < Len(.Value)
    iChar = iChar + 1
    If .Characters(Start:=iChar, Length:=1).Font.Color = 255 Then
      If iChar > 1 And .Characters(Start:=iChar - 1, Length:=1).Font.Color <> 255 Then
        strPos = strPos & "S" & iChar & ","
      ElseIf iChar = 1 Then
        strPos = strPos & iChar & ","
      End If
    Else
      If iChar > 1 Then
        If .Characters(Start:=iChar - 1, Length:=1).Font.Color = 255 Then strPos = strPos & "E" & iChar & ","
      End If
    End If
  Loop
End With
End Sub
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#3
Hallo André,

das Thema interessiert mich auch. Probiere mit:

Code:
Sub Testfärben()
ActiveCell.Characters(Start:=6, Length:=7).Font.Color = 255
End Sub

Deinen Code aus und es passiert nichts.


Sonja
to top
#4
Hab mich mal selbst dran gesetzt:
Code:
Sub ColorPosition()
'Erzeugt eine Zeichenkette mit den Start- und Endpositionen einer Einfaerbung
'Variablendeklarationen
Dim iChar As Integer, strPos As String
'Mit der aktiven Zelle
With ActiveCell
  'Schleife solange Zaehler kleiner als Laenge der Zeichenkette ist
  Do While iChar < Len(.Value)
    'Zaehler hochsetzen
    iChar = iChar + 1
    'Wenn die Farbe des Zeichens 255 ist, dann
    If .Characters(Start:=iChar, Length:=1).Font.Color = 255 Then
      'Wenn es min. das 2. Zeichen ist und die Farbe das vorigen Zeichens nicht 255, dann
      If iChar > 1 And .Characters(Start:=iChar - 1, Length:=1).Font.Color <> 255 Then
        'Startposition uebernehmen
        strPos = strPos & "S" & iChar & ","
      'Oder wenn es das erste Zeichen ist, dann
      ElseIf iChar = 1 Then
        'Startposition uebernehmen
        strPos = strPos & iChar & ","
      'Ende Wenn es min. das 2. Zeichen ist und die Farbe das vorigen Zeichens nicht 255, dann
      End If
    'Oder Wenn die Farbe des Zeichens nicht 255 ist, dann
    Else
      'Wenn es nicht das erste Zeichen ist, dann
      If iChar > 1 Then
        'Wenn die Farbe des vorhergehenden Zeichens 255 ist, dann Endposition setzen
        If .Characters(Start:=iChar - 1, Length:=1).Font.Color = 255 Then strPos = strPos & "E" & iChar & ","
      End If
    'Ende Wenn die Farbe des Zeichens 255 ist, dann
    End If
  'Ende Schleife solange Zaehler kleiner als Laenge der Zeichenkette ist
  Loop
'Ende Mit der aktiven Zelle
End With
'Ausgabe der Start- und Endpositionen
MsgBox strPos
End Sub

Den code kann man sicherlich noch eleganter lösen.
to top
#5
Hallo Sonja,

ergänze bitte vor End Sub

MsgBox strPos

ich hab ganz verpasst, den code wie von mir gewohnt zu kommentieren und hole das gleich nach. In der Zeichenkette stehen die jeweiligen Anfangs- und Endpositionen, immer mit S und E gekennzeichnet. Könnten ja auch mehrere rote Teile sein :-)
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#6
Hallo André,

habe zu diesem Thema, mal diesen Code geschrieben:
Code:
Sub Position()
Dim i As Integer, a As Integer
Range("a1").Select

'Position:
For i = 1 To Len(ActiveCell.Value)
If ActiveCell.Characters(i, 1).Font.Color = 255 Then
    For a = i To Len(ActiveCell.Value)
    If Not ActiveCell.Characters(a, 1).Font.Color = 255 Then GoTo X
    Next a
End If
Next i
X:
Debug.Print "Position: " & i & " Länge = " & a - i

End Sub

Er funktioniert und ist schön kurz. Oder gibt es dazu irgendwelche Einwände?
[-] Folgende(r) 1 Benutzer sagt Danke an SonjaFido für diesen Beitrag:
Nonexperta
to top
#7
Hallo Sonja,

ja, geht auch. Damit wird nur das erste Auftreten einer Färbung ermittelt - reicht bestimmt meistens.
Bei mir werden alle ausgegeben, und die Längen müssten noch berechnet werden.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
[-] Folgende(r) 1 Benutzer sagt Danke an schauan für diesen Beitrag:
Nonexperta
to top
#8
Hallo Sonja und André,

leider war ich ortsabwesend, deshalb kann ich mich erst jetzt bei
euch bedanken. Nachträglich aber nicht weniger herzlich
für eure Mühe und Einsatz.
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Zählenwenn Problem Datensatzzeichentiefe/-länge WergibtmirRat 6 124 04.11.2016, 19:57
Letzter Beitrag: WergibtmirRat
  maximale Länge von Diagrammen Ascolep 1 65 21.10.2016, 20:38
Letzter Beitrag: schauan
  Suche nach alpha-nummerischen Begriffen mit bestimmter Länge andrea_28 11 515 06.09.2016, 12:20
Letzter Beitrag: snb
  Fenster Position merken? mikele gross 1 233 04.07.2016, 08:22
Letzter Beitrag: schauan
  Zu lange Formel... radagast 5 451 01.06.2016, 07:11
Letzter Beitrag: chris-ka
  Zählen über lange Liste mit verschiedenen Bedingungen syquest 2 671 10.07.2015, 15:49
Letzter Beitrag: BoskoBiati
  Position von Kontrollkästchen per VB-script ermitteln Bödefeld 13 2.233 09.04.2015, 18:53
Letzter Beitrag: schauan

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste