White Man 09.01.2019 18:24
Predmet:Kako da obrisem redove sa markiranim celijama

Kako da obrisem sve redove koji u sebi imaju markirane celije? Evo i primer. Hvala unapred
Prilozi:
doc.rar (Velicina datoteke:6.26 KB)

Avko 10.01.2019 14:37
Predmet:Re: Kako da obrisem redove sa markiranim celijama

nisi napiso jeli zelis vba kod, ili uz pomoc uvjetnog oblikovanja iz menija (condicion)
Nisam neki strucnjak ali ovo mi je prvo palo na pamet.

Ovo sam samo napisao primjer koji se moze dalje razvijati prema zelji.

Kasnije se moze dodati:
- odredeno podrucje-selektirano (rangeSeleczt)
-odabrati boju koju zelis brisati
Prilozi:
doc_avko.rar (Velicina datoteke:10.58 KB)

White Man 10.01.2019 20:52
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Kako ovo da ubacim u drugu tablicu? Hvala unapred

Avko 10.01.2019 21:22
Predmet:Re: Kako da obrisem redove sa markiranim celijama

zato sam pitao
zelis li izbrisati ofarbane redove na unapred selektiranim redovima ili zelis da se to izvrsi na cijelom listu?

White Man 11.01.2019 00:06
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Na celom listu, gde prepozna markiranu celiju da obrise sve redove. Hvala unapred

Avko 11.01.2019 10:03
Predmet:Re: Kako da obrisem redove sa markiranim celijama

otvoris excel

pritisnes Alt+F11
izaberes iz menija insert + module
u taj modul ubacis ovaj kod:

PreuzmiIzvorni kôd (Text):
  1. Sub obrisiCrveniRed()
  2.     Dim lRow As Long
  3.     Dim iCntr As Long
  4.     lRow = ActiveSheet.UsedRange.Rows.Count
  5.     For iCntr = lRow To 1 Step -1
  6.         If Cells(iCntr, 1).Interior.ColorIndex = 38 Then 'boja
  7.             Rows(iCntr).Delete
  8.         End If
  9.     Next
  10. End Sub

pritisnes Alt+Q za povratak u normalni list
pritisnes Alt+F8 i sa popisa odaberes svoju makronaredbu ObrisiCrveniRed i kliknes na Pokreni

White Man 11.01.2019 10:47
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Taj kod vec postoji u onom Vasem primeru, ja sam u taj fajl iskopirao tablicu i nece, obrise samo one prve koji postoje od pre. Iskopirao sam ponovo ovaj kod sa sajta i ponovo nece. Da nema neke veze sa nijansom boje? Meni je sam excel iz konditional/duplicate values obojio celije i sad trebam da obrisem redove. Excel je 2016 ako i to ima neke veze. Hvala unapred

Avko 11.01.2019 12:15
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Citiraj White Man:
Taj kod vec postoji u onom Vasem primeru, ja sam u taj fajl iskopirao tablicu i nece, obrise samo one prve koji postoje od pre. Iskopirao sam ponovo ovaj kod sa sajta i ponovo nece. Da nema neke veze sa nijansom boje? Meni je sam excel iz konditional/duplicate values obojio celije i sad trebam da obrisem redove. Excel je 2016 ako i to ima neke veze. Hvala unapred

ima veze do color indexa, stavio sam 38 pa je obriso samo redove koji su imali 38. Postoji indexa 56 boja

idemo probati vidjeti koje se sve boje nalaze

pritisnes Alt+F11
izaberes iz menija insert + module
u taj modul ubacis ovaj kod:
(sada je to vec drugi modul modul2)

PreuzmiIzvorni kôd (Text):
  1. Sub ko****je()
  2.    
  3.     Dim lRow As Long
  4.     Dim iCntr As Long
  5.     Dim boje(56)
  6.     lRow = ActiveSheet.UsedRange.Rows.Count
  7.     For iCntr = lRow To 1 Step -1
  8.         boje(ColorIndex(Cells(iCntr, 1))) = boje(ColorIndex(Cells(iCntr, 1))) + 1
  9.     Next iCntr
  10.    
  11.     Dim txt As String
  12.    
  13.     For iCntr = 0 To 56
  14.         If boje(iCntr) > 0 Then txt = txt & CStr(iCntr) & vbNewLine
  15.        
  16.     Next iCntr
  17.     MsgBox txt
  18.    
  19. End Sub
  20.  
  21. '---------------------------------------------------------------------
  22. ' ColorIndex Function
  23. '---------------------------------------------------------------------
  24. ' Function:    Returns the colorindex of the supplied range
  25. ' Synopsis:    Initially, gets a colorindex value for black and white
  26. '              from the activeworkbook colour palette
  27. '              Then works through each cell in  the supplied range and
  28. '              determines the colorindex, and adds to array
  29. '              Finishes by returning acumulated array
  30. ' Variations:  Determines cell colour (interior) or text colour (font)
  31. '              Default is cell colour
  32. ' Constraints: Does not count colours set by conditional formatting
  33. '---------------------------------------------------------------------
  34. ' Author:      Bob Phillips
  35. '              Additions for ranges suggested by Harlan Grove
  36. '---------------------------------------------------------------------
  37.  
  38.  
  39. '---------------------------------------------------------------------
  40. Function ColorIndex(Rng As Range, _
  41.                     Optional text As Boolean = False) As Variant
  42. '---------------------------------------------------------------------
  43. Dim cell As Range, row As Range
  44. Dim i As Long, j As Long
  45. Dim iWhite As Long, iBlack As Long
  46. Dim aryColours As Variant
  47.  
  48.     If Rng.Areas.Count > 1 Then
  49.         ColorIndex = CVErr(xlErrValue)
  50.         Exit Function
  51.     End If
  52.  
  53.     iWhite = WhiteColorindex(Rng.Worksheet.Parent)
  54.     iBlack = BlackColorindex(Rng.Worksheet.Parent)
  55.  
  56.     If Rng.Cells.Count = 1 Then
  57.         If text Then
  58.             aryColours = DecodeColorIndex(Rng, True, iBlack)
  59.         Else
  60.             aryColours = DecodeColorIndex(Rng, False, iWhite)
  61.         End If
  62.  
  63.     Else
  64.         aryColours = Rng.Value
  65.         i = 0
  66.  
  67.         For Each row In Rng.Rows
  68.             i = i + 1
  69.             j = 0
  70.  
  71.             For Each cell In row.Cells
  72.                 j = j + 1
  73.  
  74.                 If text Then
  75.                     aryColours(i, j) = _
  76.                       DecodeColorIndex(cell, True, iBlack)
  77.                 Else
  78.                     aryColours(i, j) = _
  79.                       DecodeColorIndex(cell, False, iWhite)
  80.                 End If
  81.  
  82.             Next cell
  83.  
  84.         Next row
  85.  
  86.     End If
  87.  
  88.     ColorIndex = aryColours
  89.  
  90. End Function
  91.  
  92. '---------------------------------------------------------------------
  93. Private Function WhiteColorindex(oWB As Workbook)
  94. '---------------------------------------------------------------------
  95. Dim iPalette As Long
  96.     WhiteColorindex = 0
  97.     For iPalette = 1 To 56
  98.         If oWB.Colors(iPalette) = &HFFFFFF Then
  99.             WhiteColorindex = iPalette
  100.             Exit Function
  101.         End If
  102.     Next iPalette
  103. End Function
  104.  
  105. '---------------------------------------------------------------------
  106. Private Function BlackColorindex(oWB As Workbook)
  107. '---------------------------------------------------------------------
  108. Dim iPalette As Long
  109.     BlackColorindex = 0
  110.     For iPalette = 1 To 56
  111.         If oWB.Colors(iPalette) = &H0 Then
  112.             BlackColorindex = iPalette
  113.             Exit Function
  114.         End If
  115.     Next iPalette
  116. End Function
  117.  
  118. '---------------------------------------------------------------------
  119. Private Function DecodeColorIndex(Rng As Range, _
  120.                                   text As Boolean, _
  121.                                   idx As Long)
  122. '---------------------------------------------------------------------
  123. Dim iColor As Long
  124.     If text Then
  125.         iColor = Rng.Font.ColorIndex
  126.     Else
  127.         iColor = Rng.Interior.ColorIndex
  128.     End If
  129.     If iColor < 0 Then
  130.         iColor = idx
  131.     End If
  132.     DecodeColorIndex = iColor
  133. End Function
  134.  
  135. '---------------------------------------------------------------------
  136. ' End of ColorIndex Function
  137. '---------------------------------------------------------------------
  138.                

pritisnes Alt+Q za povratak u normalni list
pritisnes Alt+F8 i sa popisa odaberes svoju makronaredbu ko****je
Pokreni

Sto je napisalo, koje brojeve?

White Man 11.01.2019 17:22
Predmet:Re: Kako da obrisem redove sa markiranim celijama

2 i ispos 6. Sta sad treba da uradim? Hvala unapred

Avko 11.01.2019 18:22
Predmet:Re: Kako da obrisem redove sa markiranim celijama

u onom prvom kodu zamijenis 38 sa 2 i 6 ovako

ovo
If Cells(iCntr, 1).Interior.ColorIndex = 38 Then

sa ovime
If Cells(iCntr, 1).Interior.ColorIndex = 2 or Cells(iCntr, 1).Interior.ColorIndex = 6 Then

ajde pa javi