Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zwei Werte mit zwei Farben in eine Zelle

Zwei Werte mit zwei Farben in eine Zelle
17.12.2014 00:32:37
Heinz
Hallo Zusammen,
ich möchte in einem Feld zwei Werte (Nummern), getrennt durch ein Semikolon, speichern.
Da ich nicht weiss, wieviele Werte schlussendlich in der Zelle stehen, nehme ich einfach die Historie der bereits in der Zelle vorhandenen Werte mit, indem ich den Zelleninhalt kopiere und den neuen Inhalt hinzufüge.
Das ganze mache ich mit folgendem Skript:
Range("H9") = Range("B" & int_i + 1).Value & "; " & Range("C" & int_i + 1).Value & Chr(10) & Range("H9").Value
Um die Lesbarkeit zu verbessern, sollen die Werte in unterschiedlichen Farben in die Zelle geschrieben werden.
Also in etwa so:
Grau12345; Blau72366
Grau19237; Blau23498
Grau37383; Blau38922
Wie kann ich das machen?
Ich schon ein wenig gebastelt - aber ich krieg's nicht hin... :(
Gruß
Heinz

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
(Teil-)Textlängen u.-Positionen b.Zusammenbau ...
17.12.2014 04:49:02
Luc:-?
…ermitteln und .Characters-Methode einsetzen, Heinz.
Morrn, Luc :-?

AW: (Teil-)Textlängen u.-Positionen b.Zusammen ...
17.12.2014 22:19:54
Heinz
Ich habe jetzt mehrere Stunden geknobelt - ich krieg's nicht hin :(
Ich kann zwar den Werten für sich jeweils eine Zelle zuweisen und die Formatieren oder sowas - aber ich muss das ganze ja auch irgendiwe wieder zusammen bauen.
Ich hätte jetzt gedacht, ich muss da irgendiwe zwei Objekte basteln, die ich dann miteinander verbinde.
Aber irgendiwe scheine ich auf dem kompolett falschem Pfad zu sein.... :(
Weitergehende Hilfestellung ist willkommen!
Gruß
Heinz

AW: (Teil-)Textlängen u.-Positionen b.Zusammen ...
18.12.2014 07:39:53
Mullit
Hallo Heinz,
da kamen mir irgendwie zwei Möglichkeiten in den Sinn, vielleicht ist was dabei.....
Option Explicit

Public Sub test()
Dim lngIndex As Long, lngCount As Long, _
  lngColor As Long, lngSearchPos As Long, _
  lngLength As Long, lngRow As Long
  Application.ScreenUpdating = False
  With Cells(9, 8) '"H9" 
        .ClearContents
        For lngRow = 9 To 18
           .Value = Cells(lngRow + 1, 2).Value & "; " & Cells(lngRow + 1, 3).Value & "; " & Chr(10) & .Value
        Next
        lngIndex = 1
        lngCount = 1
        Do
           Select Case lngCount
              Case Is = 1: lngColor = vbBlue
              Case Is = 2: lngColor = vbCyan
              Case Is = 3: lngColor = vbGreen
              Case Is = 4: lngColor = vbMagenta
              Case Is = 5: lngColor = vbRed
              Case Is = 6: lngColor = vbBlack
           End Select
           lngSearchPos = InStr(lngIndex, .Text, ";", vbTextCompare)
           If lngSearchPos <> 0 Then
             lngLength = lngSearchPos
             If lngCount = 6 Then
               lngCount = 1
             Else
               lngCount = lngCount + 1
             End If
           Else
             lngLength = .Characters.Count
           End If
           .Characters(Start:=lngIndex, Length:=lngLength).Font.Color = lngColor
           lngIndex = lngSearchPos + 1
        Loop While lngIndex < .Characters.Count And lngSearchPos <> 0
  End With
  Application.ScreenUpdating = True
End Sub

Public Sub test2()
Dim lngIndex As Long, lngCount As Long, _
  lngColor As Long, lngRow As Long
Dim avntArray As Variant
Dim vntElem As Variant
Application.ScreenUpdating = False
With Cells(9, 8) '"H9" 
     .ClearContents
     For lngRow = 9 To 18
        .Value = Cells(lngRow + 1, 2).Value & "; " & Cells(lngRow + 1, 3).Value & "; " & Chr(10) & .Value
     Next
     avntArray = Split(Expression:=.Text, Delimiter:="; ", Compare:=vbTextCompare)
     lngIndex = 1
     lngCount = 1
     For Each vntElem In avntArray
         If vntElem = Chr(10) Then Exit For
         Select Case lngCount
            Case Is = 1: lngColor = vbBlue
            Case Is = 2: lngColor = vbCyan
            Case Is = 3: lngColor = vbGreen
            Case Is = 4: lngColor = vbMagenta
            Case Is = 5: lngColor = vbRed
            Case Is = 6: lngColor = vbBlack
         End Select
         If lngCount = 6 Then
           lngCount = 1
         Else
           lngCount = lngCount + 1
         End If
         .Characters(Start:=InStr(lngIndex, .Text, vntElem, vbTextCompare), _
           Length:=Len(vntElem) + 1).Font.Color = lngColor
         lngIndex = Len(vntElem) + 2
     Next
End With
Application.ScreenUpdating = True
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 14

Gruß, Mullit
Anzeige

358 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige