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

• #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