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

• #18272 Mutt senior tag kvoaksz #18243

  Új Válasz 2013-06-12 22:41:05 #18272

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

  Hello,

  Delila_1 megoldása mellett csak függvényeken alapuló megoldásomat innen tudod letölteni.

  

  A színes naptár valójában egy feltételes formázást tartalmazó táblázat. Az adott napokhoz vagy 0, vagy 1-et iratok ki attól függően hogy a név a vizsgált dátummal szerepel-e a beviteli listán vagy sem. Ha szerepel akkor 1 a függvény értéke és ekkor van pirossal kitöltve a cella. A függvény pedig egy sima DARABHATÖBB.
  A 0 és 1 értékeket elrejtettem egy egyedi számformátummal így nem látszanak, de az Excel tud számolni velük.

  Próbáltam interaktívvá tenni ezért van még pár plusz számítás is és formázás is, ezek főleg a számítás lapon vannak. Ezzel csak a beviteli lista első 1000 sorát figyelem és csak az első 25 nevet rakom ki a naptár oldalra.

  Egy igazán profi megoldást a http://chandoo.org/wp/2013/01/24/employee-vacations-tracker-dashboard/ oldalról tudsz letölteni.

  üdv.

• #18244 Delila_1 veterán kvoaksz #18243

  Új Válasz 2013-06-11 12:28:59 #18244

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

  Írtam rá egy makrót.
  Az A oszlop adataiból az egyedi értékeket kigyűjti az E oszlopba, és ezek mellett színez, ahogy írtad.
  Az F1:AJ1 tartományban dátumok vannak – ezeket írd be –, a cellaformátumuk nn.

  

  Sub Szinezes()
  Dim sor As Long, usor As Long, sor1 As Long, oszlop As Integer
  Dim elsodat As Date, ucsodat As Date, nev$
  
  'Irányított szűrés az E oszlopba
  Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  "E1"), Unique:=True
  
  'Előző napok hátterének festése fehérre
  Range("F1:AJ1000").Interior.ColorIndex = 2
  
  'Színezés
  usor = Range("A" & Rows.Count).End(xlUp).Row
  For sor = 2 To usor
  nev$ = Cells(sor, "A")
  elsodat = Cells(sor, "B")
  ucsodat = Cells(sor, "C")
  sor1 = Application.WorksheetFunction.Match(nev$, Columns(5), 0)
  For oszlop = 6 To 36
  If Cells(1, oszlop) >= elsodat And Cells(1, oszlop) <= ucsodat Then
  Cells(sor1, oszlop).Interior.ColorIndex = 3
  End If
  Next
  Next
  End Sub

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