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

• #17635 Delila_1 veterán kekkec #17631

  Új Válasz 2013-04-06 08:11:46 #17635

  Ú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

  

  Delila_1

  veterán

  válasz kekkec #17631 üzenetére

  Mit szólsz ehhez? Csak összedobtam, rendes értékeket kell kitalálni a határoknak, és az RGB elemeinek.
  A lap Change eseményéhez kötheted.

  Sub mnmn()
  usor% = Range("A1").End(xlDown).Row
  atlag = Application.WorksheetFunction.Average(Range("A1:A" & usor%))
  hatar1 = atlag * (1 + 0.1)
  hatar2 = atlag * (1 + 0.3)
  hatar3 = atlag * (1 - 0.5)
  hatar4 = atlag * (1 - 0.7)
  hatar5 = atlag * (1 - 0.8)
  
  For sor% = 1 To usor%
  Select Case Cells(sor%, 1)
  Case Is < hatar5
  Range(Cells(sor%, 1), Cells(sor%, 10)).Interior.Color = RGB(0, 0, 250)
  Case hatar5 To hatar4
  Range(Cells(sor%, 1), Cells(sor%, 10)).Interior.Color = RGB(255, 0, 0)
  Case hatar4 To hatar3
  Range(Cells(sor%, 1), Cells(sor%, 10)).Interior.Color = RGB(120, 120, 0)
  Case hatar3 To hatar2
  Range(Cells(sor%, 1), Cells(sor%, 10)).Interior.Color = RGB(100, 200, 80)
  Case hatar2 To hatar1
  Range(Cells(sor%, 1), Cells(sor%, 10)).Interior.Color = RGB(200, 120, 60)
  End Select
  Next
  End Sub

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