Zeichen auf 4 stellen links/rechts einfärben

Forumthread: Zeichen auf 4 stellen links/rechts einfärben

22.11.2008 09:04:00

Bernie

Hallo Leute,
ich habe ein kleines Problem mit einer Telefonliste, welche ich ausdrucken will.
Die Telefonnummern stehen immer in der Spalte B, beginnend in Zeile 2.
Für den Ausdruck möchte ich die ersten 4 Ziffern und die letzten 4 Ziffern der jeweiligen Rufnummer farblich kennzeichnen.
Da meine Liste z.Teil bis zu 500 Einträge hat, ist das müssig alles von Hand zu machen.
Vielleicht kann mir jemand helfen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeichen auf 4 stellen links/rechts einfärben

22.11.2008 09:41:00

hary

Hallo Bernie
versuchs mal so.


Dim a As Long
Dim lg As Long
Dim i As Long
Sub Farbe()
i = Cells(Rows.Count, 2).End(xlUp).Row
For a = 2 To i
lg = Len(Cells(a, 2).Text)
Cells(a, 2).Characters(Start:=1, Length:=4).Font.ColorIndex = 3
Cells(a, 2).Characters(Start:=lg - 3, Length:=4).Font.ColorIndex = 3
Next
End Sub

Gruss hary

AW: Zeichen auf 4 stellen links/rechts einfärben

22.11.2008 11:13:27

Bernie

Hallo Harry
vielen Dank für die schnelle Hilfe - Das klappt super
bernie

AW: Zeichen auf 4 stellen links/rechts einfärben

22.11.2008 09:42:18

robert

hallo,
meinst du so?
gruß
rofu
https://www.herber.de/bbs/user/57044.xls

AW: Zeichen auf 4 stellen links/rechts einfärben

22.11.2008 09:58:00

Tino

Hallo,
teste mal diesen Code, Du wirst zur Auswahl von zwei Farben aufgefordert.
Da unter xl2007 nicht alle Farben verwendet werden, kann es sein dass mansche Farben nicht wie ausgewählt angezeigt werden.
Modul Modul1

Option Explicit 
 
Sub Start() 
Dim i As Long, iStartRechts As Integer 
Dim Farbe1 As Double, Farbe2 As Double 
Farbe1 = ColorFromPallet 'Auswahl Farbe 1 
Farbe2 = ColorFromPallet 'Auswahl Farbe 2 
 
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row 
    With Cells(i, "B") 
         If Len(.Value) > 7 Then 
              iStartRechts = Len(.Value) - 3 
                .Characters(Start:=1, Length:=4).Font.Color = Farbe1 
                .Characters(Start:=iStartRechts, Length:=4).Font.Color = Farbe2 
         End If 
    End With 
Next i 
 
End Sub 
 
 
Function ColorFromPallet(Optional lOldCol As Double = xlNone) As Double 
    Dim dSavCol As Double, dNewCol As Double 
    Dim iRGB_R As Integer, iRGB_G As Integer, iRGB_B As Integer 
   
    dSavCol = ActiveWorkbook.Colors(32) 
    If lOldCol = xlNone Then 
        ColIx2RGB 13160660, iRGB_R, iRGB_G, iRGB_B 
    Else 
        ColIx2RGB lOldCol, iRGB_R, iRGB_G, iRGB_B 
    End If 
    If Application.Dialogs(xlDialogEditColor).Show _
        (32, iRGB_R, iRGB_G, iRGB_B) Then 
        ColorFromPallet = ActiveWorkbook.Colors(32) 
        ActiveWorkbook.Colors(32) = dSavCol 
    Else 
        ColorFromPallet = lOldCol 
    End If 
End Function 
 
Sub ColIx2RGB(ByVal lCol As Long, _
              iR As Integer, iG As Integer, iB As Integer) 
  iR = lCol Mod 256:  lCol = lCol \ 256 
  iG = lCol Mod 256:  lCol = lCol \ 256 
  iB = lCol Mod 256 
End Sub

Gruß Tino

www.VBA-Excel.de

AW: Tino ist der Grösste!!

22.11.2008 10:28:00

robert

noch nicht, aber auf dem Weg dorthin ;-) oT.

22.11.2008 10:46:00

Tino

AW: Zeichen auf 4 stellen links/rechts einfärben

22.11.2008 11:15:47

Bernie

Hallo Tino
auch Dein Marko habe ich ausprobiert - das ist einfach genial - und arbeitet perfect.
Vielen Dank
Bernie

Beliebteste Forumthreads (12 Monate)

Zeichen auf 4 stellen links/rechts einfärben

Forumthread: Zeichen auf 4 stellen links/rechts einfärben

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread