Új hozzászólás Aktív témák

• #18532 Mutt senior tag rebb #18514

  Új Válasz 2013-07-15 21:23:02 #18532

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz rebb #18514 üzenetére

  Hello,

  ...ha egy fehér munkalapon az egyik cella színét megváltoztatom (pl:sárgára) akkor egy másik munkalapon lévő hivatkozás ne az eredeti értéket vegye alapul, hanem egy előre beállított értéket. (pl: sárga esetén =SZ)

  Delila_1 megoldása mellett én is csináltam egy változatot.
  Ahogy már olvastad cella színére nincs alapból esemény, ezért valós időben megfogni nem lehet.
  Azt választottam, hogy egy ún. volatile függvényt írtam, amely akkor is frissül, ha az érintett cellában nincs változás. Ez azt jelenti, hogy ha vhol módosítasz akkor máris frissül az eredmény.
  Az UDF használata:
  =ColorDecode(vizsgalando cella;színkód1;eredmény1;színkód2;eredmény2;....)

  Ahol a színkód pl. fekete, sárga, piros stb. Az eredmény lehet szöveg, másik cella, képlet. Ha nincs találat, akkor az eredei cellát adja vissza.

  pl. =ColorDecode(A2;"fekete";-100;"piros";2*2;"zöld";"Z+")
  Vagyis ha az A2 színe fekete akkor -100-t ír, ha zöld akkor "Z+"t, sárga esetén pedig az A2 cella értékét.

  Itt a kód, amelyet te is tudsz bővíteni, csak a színeket és a hozzájuk tartozó kódokat kell felsorolnod. Ezt megkapod, ha csak egy paramétert használsz, pl. ColorDecode(A2)

  Function ColorDecode(original As Range, ParamArray contents()) As Variant
  Const ColorNum As Integer = 10 'ha 10-nél több szín formázást akarunk
  Const ColorNames As String = "FEKETE,SÖTÉTVÖRÖS,PIROS,NARANCS,SÁRGA,VILÁGOSZÖLD,ZÖLD,KÉK,SÖTÉTKÉK,LILA"
  Const ColorCodes As String = "0,192,255,49407,65535,5296274,5287936,15773696,6299648,10498160"
  Dim vOriginalColor As Long
  Dim arrayColors(1 To 2, 1 To 10) 'itt is a 10 javítani, ha fent átírod
  Dim i As Integer
  Dim s1, s2
  Dim blnColorMatch As Boolean
  Dim strMatch As String
  Dim blnInputMatch As Boolean
  
  'fusson le minden újraszámláláskor
  Application.Volatile
  
  'visszadjuk az eredeti értéket, ha nem találunk mást
  ColorDecode = original
  
  'az eredeti cella színét megnézzük
  vOriginalColor = original.Interior.Color
  
  Select Case UBound(contents)
  'ha nincs paraméter akkor kiírjuk a színkódot
  Case -1
  ColorDecode = "Cella színkódja: " & vOriginalColor
  
  'több paraméter esetén visszatér a megadott értékkel, ha tud
  Case Else
  'feltöltjük az ismert kódokat tömbbe
  s1 = Split(ColorCodes, ",")
  s2 = Split(ColorNames, ",")
  For i = 1 To ColorNum
  arrayColors(1, i) = s1(i - 1)
  arrayColors(2, i) = s2(i - 1)
  Next i
  
  'megkeressük, hogy ezt a színt ismerjük-e
  i = 0
  blnColorMatch = False
  
  Do
  i = i + 1
  If arrayColors(1, i) = vOriginalColor Then
  blnColorMatch = True
  strMatch = arrayColors(2, i)
  End If
  Loop Until blnColorMatch Or i = ColorNum
  
  'ha a színt ismerjük, akkor megnézzük, hogy adtak-e rá paramétert
  If blnColorMatch Then
  blnInputMatch = False
  i = 0
  Do
  'ha megtaláljuk, akkor a kövekező bemeneti paramétert írjuk ki
  If strMatch = UCase(contents(i)) Then
  ColorDecode = contents(i + 1)
  blnInputMatch = True
  End If
  i = i + 2
  Loop Until blnInputMatch Or i > UBound(contents)
  End If
  End Select
  End Function

  Bővítésnél a kód elején adj meg egy nevet, majd alatta a kódját. Ha 10-nél több kombinációd van akkor az első konstanst is emeld meg és a Dim arrayColors(1 To 2, 1 To 10) sorban is javítsd a 10-es számot.

  üdv.

Új hozzászólás Aktív témák