Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Jaka wykorzystać funkcje?

ariel_matrix · forumowicz Posty: 15

Witam,

szukam jakiegoś rozwiązania, funkcji makra czy czego kolwiek.
mój problem polega na tym, ze:
mam w jednej kolumnie kilka tysięcy wartości i bym chciał by te wartości miały 3 kolory, jak są koło siebie to miały jeden kolor, wtedy ciąg następnych wartości drugi kolor i nastepny ciag trzeci kolor, i wtedy jak się zacznie czwarty ciąg to już może mieć znowu pierwszy kolor...

ciąg wartości - kolor
1 - czer
1 - czer
1 - czer
2 - zolty
2 - zolty
2 - zolty
3 - nieb
3 - nieb
3 - nieb
4 - czer
4 - czer
4 - czer
4 - czer
5 - zolty
5 - zolty
6 - nieb
6 - nieb
6 - nieb

jak cos to w excelu mogę pokazać...
prosze o pomoc

tkuchta1 · Excel Expert **Pomógł:** 1495 razy Posty: 2270

może tak

Kod:

Option Explicit

Sub Koloruj()
Dim xlWks As Excel.Worksheet, i As Long
Dim arrColor As Variant: arrColor = VBA.Array(3, 6, 5)
Dim vVal As Variant, iArr As Integer: iArr = -1

Set xlWks = ThisWorkbook.Worksheets("Arkusz1")
With xlWks
For i = 1 To Last(.Columns("A"))
With .Cells(i, "A")
If vVal <> .Value Then
vVal = .Value
iArr = iArr + 1
If iArr > UBound(arrColor) Then iArr = 0
End If
.Interior.ColorIndex = arrColor(iArr)
End With
Next
End With
Set xlWks = Nothing
End Sub

Function Last(rng As Range)
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

bez tytułu.PNG

Plik ściągnięto 148 raz(y) 4.05 KB

Zeszyt1.zip

Pobierz Plik ściągnięto 8 raz(y) 9.28 KB

Kaper · Excel Expert **Pomógł:** 1152 razy Posty: 1626

chyba też bym zrobił makrem - np. takim - ustawiam kursor w pierwszej komórce do kolorowania i uruchamiam:

Kod:

Option Explicit

Sub koloruj()
Dim gdzie As Range
Dim poprzednia As Variant
Dim kolor As Variant
Dim ktora As Integer
Const kolory = "38:36:37" 'albo "3:6:5"

ktora = 0
kolor = Split(kolory, ":")
Set gdzie = Selection(1, 1)

While Not IsEmpty(gdzie)
Debug.Print gdzie.Address
gdzie.Interior.ColorIndex = kolor(ktora)
poprzednia = gdzie.Value
Set gdzie = gdzie.Offset(1, 0)
If poprzednia <> gdzie.Value Then ktora = (ktora + 1) Mod 3
Wend

End Sub

Pozdrawiam,

ariel_matrix · forumowicz Posty: 15

oby dwa bardzo zbliżone do siebie, ale drugie powiem, ze lepsze bo jest możliwość zaczęcia od drugiego wiersza.
tylko pytanie mam jest możliwość jakiegoś szybkiego uruchomienia tego makra ?
jakiś skrót klawiszowy? już sobie poradziłem z tym :)