Registriert seit: 30.10.2014
Version(en): 2013
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!
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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-2019+365)
Registriert seit: 27.07.2014
Version(en): 2013
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
Registriert seit: 27.07.2014
Version(en): 2013
30.10.2014, 18:03
(Dieser Beitrag wurde zuletzt bearbeitet: 30.10.2014, 18:14 von schauan.)
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.
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
30.10.2014, 18:06
(Dieser Beitrag wurde zuletzt bearbeitet: 30.10.2014, 18:06 von schauan.)
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-2019+365)
Registriert seit: 27.07.2014
Version(en): 2013
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?
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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-2019+365)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28
• Nonexperta
Registriert seit: 30.10.2014
Version(en): 2013
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.
|