Centar za edukaciju-BiH

iCentar → Racunari i oprema → Softver i operativni sistemi → Ms office


Prosiri i skupi Opcije teme
Stranice (4):1,2,3,4
 Prikazi prvu neprocitanu poruku

#11 11.01.2019 20:57
White Man Van mreze
Clan
Registrovan od:11.03.2011
Postovi:341


Predmet:Re: Kako da obrisem redove sa markiranim celijama
Nece. Sta trebam da uradim sad? Hvala unapred
↑  ↓

#12 12.01.2019 10:11
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,807


Predmet:Re: Kako da obrisem redove sa markiranim celijama
mozda vba nece kod uvjetnog oblikovanja ili je mozda trebalo sa RGB() neznam, evo moze se i ovako:









zivot je moja domovina.
↑  ↓

#13 12.01.2019 20:32
White Man Van mreze
Clan
Registrovan od:11.03.2011
Postovi:341


Predmet:Re: Kako da obrisem redove sa markiranim celijama
To je to, hvala puno. Jos nesto samo, kad obrisem duplikate, on automatski skloni markere. Jel moze nekako prvo da se podese markeri da budu trajni? Da mogu videti koji su bili duplikata. Hvala puno unapred
↑  ↓

#14 12.01.2019 23:30
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,807


Predmet:Re: Kako da obrisem redove sa markiranim celijama
Citiraj White Man:
To je to, hvala puno. Jos nesto samo, kad obrisem duplikate, on automatski skloni markere. Jel moze nekako prvo da se podese markeri da budu trajni? Da mogu videti koji su bili duplikata. Hvala puno unapred

nisam razumio pitanje
zivot je moja domovina.
↑  ↓

#15 13.01.2019 10:59
White Man Van mreze
Clan
Registrovan od:11.03.2011
Postovi:341


Predmet:Re: Kako da obrisem redove sa markiranim celijama
Ako imam kao u Vasem primeru dva puta banane u dva reda, i one su markirane zutom bojom, kad selektujem jedan red i obrisem, ostane mi drugi red gde pise banana, ali ona vise nema marker, nije zuta.
↑  ↓

#16 13.01.2019 14:18
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


Predmet:Re: Kako da obrisem redove sa markiranim celijama
PreuzmiIzvorni kôd (Visual Basic):
  1. Sub sbDelete_Rows_Based_On_Cell_Color()
  2. Dim Rng As Range
  3. Dim ws As Worksheet
  4. Dim ZadnjaKolona As Long
  5. Dim ZadnjiRed As Long
  6. Dim Celija As Range
  7. Dim I As Integer, N As Integer
  8.  
  9. '***********************************************
  10. 'avkina stara procedura samo malo prepravio
  11. '**********************************************
  12. Set ws = Application.ActiveSheet
  13. Set Celija = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
  14.                                     LookAt:=xlPart, SearchOrder:=xlByColumns, _
  15.                                     SearchDirection:=xlPrevious, MatchCase:=False)
  16.  ZadnjaKolona = Celija.Column
  17.  Set Celija = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
  18.                                     LookAt:=xlPart, SearchOrder:=xlByRows, _
  19.                                     SearchDirection:=xlPrevious, MatchCase:=False)
  20.  ZadnjiRed = Celija.Row
  21. Dim a
  22. For I = 1 To ZadnjiRed
  23.   For N = 1 To ZadnjaKolona
  24.     If Cells(I, N).Interior.ColorIndex <> -4142 Then 'boja
  25.        Rows(I).Delete
  26.     End If
  27.   Next N
  28. Next I
  29. End Sub
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#17 13.01.2019 16:08
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,807


Predmet:Re: Kako da obrisem redove sa markiranim celijama
evo stigo zxz jer nije mogao vise mene da doceka.
Meni je bilo ovo tesko.

ajmo jos ovako pa da vidimo

metodom staviti kod u modul1 stavi ovo:

PreuzmiIzvorni kôd (Text):
  1. Sub duplikati()
  2.     If obojiDuplikate = True Then
  3.         If obrisiDuplikate = False Then
  4.             MsgBox "GRESKA! u brisanju duplikata"
  5.             Stop
  6.         End If
  7.     Else
  8.         MsgBox "GRESKA! u bojanju duplikata"
  9.         Stop
  10.     End If
  11. End Sub
  12.  
  13. Function obojiDuplikate() As Boolean
  14.     obojiDuplikate = False
  15.    
  16.     Dim LLoop As Integer
  17.     Dim LTestLoop As Integer
  18.     Dim LClearRange As String
  19.     Dim Lrows As Integer
  20.     Dim Lcol As Integer
  21.     Dim LRange As String
  22.  
  23.     'A kolona, vrijednosti
  24.     Dim LChangedValue As String
  25.     Dim LTestValue As String
  26.  
  27.     'B kolona vrijednosti
  28.     Dim LChangedValueB As String
  29.     Dim LTestValueB As String
  30.  
  31.     'Lrows=zadnjiRed
  32.     With ActiveSheet
  33.         Lrows = .Cells(Rows.count, "A").End(xlUp).Row
  34.         Lcol = .Cells(1, Columns.count).End(xlToLeft).Column
  35.     End With
  36.  
  37.     LLoop = 2
  38.  
  39.     'obrisi boje ispune
  40.     LClearRange = "A2:B" & Lrows
  41.     Range(LClearRange).Interior.ColorIndex = xlNone
  42.  
  43.     'provjeri sve redove
  44.     While LLoop <= Lrows
  45.         LChangedValue = "A" & CStr(LLoop)
  46.         LChangedValueB = "B" & CStr(LLoop)
  47.         If Len(Range(LChangedValue).Value) > 0 Then
  48.  
  49.          'Nadi jedinstvenu vrijednost
  50.          LTestLoop = 2
  51.          While LTestLoop <= Lrows
  52.             If LLoop <> LTestLoop Then
  53.                LTestValue = "A" & CStr(LTestLoop)
  54.                LTestValueB = "B" & CStr(LTestLoop)
  55.                'vrijednost je duplikat u drugoj celiji
  56.                If (Range(LChangedValue).Value = Range(LTestValue).Value) And (Range(LChangedValueB).Value = Range(LTestValueB).Value) Then
  57.                   'postavi crvenu boju pozadine u A stupcu
  58.                   Range(LChangedValue).Interior.ColorIndex = 3
  59.                   Range(LTestValue).Interior.ColorIndex = 3
  60.  
  61.                   'postavi crvenu boju pozadine u B stupcu
  62.                   'ovo netreba
  63.                   Range(LChangedValueB).Interior.ColorIndex = 3
  64.                   Range(LTestValueB).Interior.ColorIndex = 3
  65.                End If
  66.             End If
  67.             LTestLoop = LTestLoop + 1
  68.             Wend
  69.         End If
  70.         LLoop = LLoop + 1
  71.     Wend
  72.     obojiDuplikate = True
  73. End Function
  74.  
  75. Function obrisiDuplikate() As Boolean
  76.     obrisiDuplikate = False
  77.    
  78.     Dim rCell As Range
  79.     Dim rRange As Range
  80.     Dim lCount As Long
  81.      
  82.     Set rRange = Range("A1", Range("A" & Rows.count).End(xlUp))
  83.     lCount = rRange.Rows.count
  84.      
  85.     For lCount = lCount To 1 Step -1
  86.         With rRange.Cells(lCount, 1)
  87.             If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
  88.                 .EntireRow.Delete
  89.             End If
  90.         End With
  91.     Next lCount
  92.     obrisiDuplikate = True
  93. End Function

metodom dodijeli kod dugmetu (kao sto sam prije rekao i objasnio), dodijeli mu makronaredbu imena : duplikati.

sada kada kliknes na dugme kod poziva funkciju koja oboji sve duplikate, a zatim se pozove funkcija obrisi duplikate, stime da ostane obojen jedan duplikat.

evo i excel primjer sa vocem.

Napomena : trebao si nam odmah na pocetku reci da si trazio duplikate metodom uvjetnog oblikovanja. Mislim da vba nemoze dijelovati na uvjetno oblikovanje ili moze...

Prilozi:
Informacije o tipu datoteke za:rar  avko_01.rar
Preuzimanja:171
Velicina datoteke:18.08 KB

zivot je moja domovina.
Ovaj post je ureden 1 puta. Posljednja izmjena 13.01.2019 16:09 od strane Avko. ↑  ↓

#18 13.01.2019 19:30
White Man Van mreze
Clan
Registrovan od:11.03.2011
Postovi:341


Predmet:Re: Kako da obrisem redove sa markiranim celijama
Tako treba da radi kao u Vasem primeru, tu radi odlicno kad otvorim primer. Ali kad prebacim cod kod mene i idem na run, krene lepo, oboji nekoliko redova u crveno i onda zablokira, pobeli i pojavi se not responding. Da li trebam i kod mene da kreiram ono dugme pa preko njega ili je to sto u tablici ima vise od 50 hiljada redova jer se vecinom svaki artikl ponavlja po 50, 60 puta aneki i vise. Sta trebam da uradim? Hvala unapred

Slicice prilozenih slika:
Untitled.jpg
Tip datoteke:Informacije o tipu datoteke za:jpg jpg
Preuzimanja:177
Velicina datoteke:27.46 KB
Velicina slike: 1597 x 855 Pikseli

↑  ↓

#19 13.01.2019 19:42
Gjoreski Van mreze
Administrator
Registrovan od:02.02.2009
Postovi:1,854


Predmet:Re: Kako da obrisem redove sa markiranim celijama
U modulu zameni gi svi variable koi su integer sa Long
i probaj tako
↑  ↓

#20 13.01.2019 23:30
White Man Van mreze
Clan
Registrovan od:11.03.2011
Postovi:341


Predmet:Re: Kako da obrisem redove sa markiranim celijama
Dim LLoop As Integer
Dim LTestLoop As Integer
Dim Lrows As Integer
Dim Lcol As Integer

Kod ovih? Hvala unapred
↑  ↓

Stranice (4):1,2,3,4

Srodne teme

Ko je online?

Aktivni clanovi:
nema clanova


Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 1: 10 am.