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

• #17667 Delila_1 veterán kekkec #17665

  Új Válasz 2013-04-08 20:51:25 #17667

  Ú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 #17665 üzenetére

  Ha rögtön a mostani képet adod meg, nem kellett volna duplán dolgozni. Igaz, az elmélet kitalálása volt a nehezebb dolog.

  A színkódokat ismét a 2. lapra kell tenni, mint előzőleg, az A1:C10 tartományba. Ezeket az értékeket kedved, és ízlésed szerint módosíthatod.

  Az új, laphoz rendelt makró:

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row < 28 And Target.Row > 2 And Target.Row Mod 2 = 1 Then
  maxx = Application.WorksheetFunction.Max(Range("B" & Target.Row & ":N" & Target.Row))
  R = Application.Transpose(Sheets(2).Range("A1:A10"))
  G = Application.Transpose(Sheets(2).Range("B1:B10"))
  B = Application.Transpose(Sheets(2).Range("C1:C10"))
  hatar1 = maxx * 0.1
  hatar2 = maxx * 0.2
  hatar3 = maxx * 0.3
  hatar4 = maxx * 0.4
  hatar5 = maxx * 0.5
  hatar6 = maxx * 0.6
  hatar7 = maxx * 0.7
  hatar8 = maxx * 0.8
  hatar9 = maxx * 0.9
  
  For oszlop = 2 To 14
  On Error Resume Next
  szam% = Cells(Target.Row, oszlop)
  Set ter = Range(Cells(Target.Row - 1, oszlop), Cells(Target.Row, oszlop))
  Select Case szam%
  Case Is <= hatar1
  ter.Interior.Color = RGB(R(1), G(1), B(1))
  Case hatar1 To hatar2
  ter.Interior.Color = RGB(R(2), G(2), B(2))
  Case hatar2 To hatar3
  ter.Interior.Color = RGB(R(3), G(3), B(3))
  Case hatar3 To hatar4
  ter.Interior.Color = RGB(R(4), G(4), B(4))
  Case hatar4 To hatar5
  ter.Interior.Color = RGB(R(5), G(5), B(5))
  Case hatar5 To hatar6
  ter.Interior.Color = RGB(R(6), G(6), B(6))
  Case hatar6 To hatar7
  ter.Interior.Color = RGB(R(7), G(7), B(7))
  Case hatar7 To hatar8
  ter.Interior.Color = RGB(R(8), G(8), B(8))
  Case hatar8 To hatar9
  ter.Interior.Color = RGB(R(9), G(9), B(9))
  Case Is > hatar9
  ter.Interior.Color = RGB(R(10), G(10), B(10))
  End Select
  Next
  End If
  End Sub

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