Centar za edukaciju-BiH
Glavni meni
Portal
iCentar
Statistike
Procitajte pravila
Donacije
Forumi
Racunari i oprema
Softver i op. sistemi
Hardver i mreze
Programiranje i baze
Nauka i tehnika
Nauka
Tehnika
Dom, porodica, biznis
Dom i porodica
Biznis
Sport i zabava
Sport i rekreacija
Zabava
Ostalo
Zanimljivosti
Linkovi
Zonic Design
iCentar
→
Racunari i oprema
→
Softver i operativni sistemi
→
Ms office
→
Kako da obrisem redove sa markiranim celijama
Pretrazi
Tim
Registriraj se
Vazni alati
Razno. veze
Oznaci forume kao procitane
Smjernice
Aktivne teme ...
u posljednja 24 sata
od moje posljednje posjete
Vijesti (RSS, ...)
RSS 2.0
RSS 1.0
OPML
Klipfolio
Atom 1.0
Prijavi se
Odgovori na temu
Korisnicko ime:
Adresa e-poste:
Sigurnosna provjera:
Unesite znakove na slici. Ovo bi trebalo izbjeci nezeljenu postu.
Predmet:
Objavi:
Pomoc
Boja
Odaberite boju
Velicina
Odaberite velicinu
Veliki font
Mali font
Prosireni font
vise smajlica
vise smajlica
Crazy
Egoistic
Helpless
Angel
Question
Attention
Information
E-mail
Search
No
Idea
Heart
Have a look-around
Yes
[quote=Avko][code] Sub duplikati() If obojiDuplikate = True Then If obrisiDuplikate = False Then MsgBox "GRESKA! u brisanju duplikata" Stop End If Else MsgBox "GRESKA! u bojanju duplikata" Stop End If End Sub Function obojiDuplikate() As Boolean obojiDuplikate = False Dim LLoop As Long Dim LTestLoop As Long Dim LClearRange As String Dim Lrows As Long Dim Lcol As Long Dim LRange As String 'A kolona, vrijednosti Dim LChangedValue As String Dim LTestValue As String 'B kolona vrijednosti Dim LChangedValueB As String Dim LTestValueB As String With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With 'Lrows=zadnjiRed With ActiveSheet Lrows = .Cells(Rows.count, "A").End(xlUp).Row Lcol = .Cells(1, Columns.count).End(xlToLeft).Column End With LLoop = 2 'obrisi boje ispune LClearRange = "A2:B" & Lrows Range(LClearRange).Interior.ColorIndex = xlNone 'provjeri sve redove While LLoop <= Lrows LChangedValue = "A" & CStr(LLoop) LChangedValueB = "B" & CStr(LLoop) If Len(Range(LChangedValue).Value) > 0 Then 'Nadi jedinstvenu vrijednost LTestLoop = 2 While LTestLoop <= Lrows If LLoop <> LTestLoop Then LTestValue = "A" & CStr(LTestLoop) LTestValueB = "B" & CStr(LTestLoop) 'vrijednost je duplikat u drugoj celiji If (Range(LChangedValue).Value = Range(LTestValue).Value) And (Range(LChangedValueB).Value = Range(LTestValueB).Value) Then 'postavi crvenu boju pozadine u A stupcu Range(LChangedValue).Interior.ColorIndex = 3 Range(LTestValue).Interior.ColorIndex = 3 'postavi crvenu boju pozadine u B stupcu 'ovo netreba Range(LChangedValueB).Interior.ColorIndex = 3 Range(LTestValueB).Interior.ColorIndex = 3 End If End If LTestLoop = LTestLoop + 1 Wend End If LLoop = LLoop + 1 Wend obojiDuplikate = True With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Function Function obrisiDuplikate() As Boolean obrisiDuplikate = False Dim rCell As Range Dim rRange As Range Dim lCount As Long With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set rRange = Range("A1", Range("A" & Rows.count).End(xlUp)) lCount = rRange.Rows.count For lCount = lCount To 1 Step -1 With rRange.Cells(lCount, 1) If WorksheetFunction.CountIf(rRange, .Value) > 1 Then .EntireRow.Delete End If End With Next lCount obrisiDuplikate = True With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Function [/code][/quote]
Povecaj velicinu
·
Smanji velicinu
Provjeri duzinu
Opcije:
Pretvori smajlice u postu
Pretvori & quot; vokable & quot; u postu
Prilozi:
Upravljanje prilozima
Mozete priloziti 3 datoteke!
Posljednjih 15 postova u ovoj temi
Ova tema sadrzi vise od 15 postova. Kliknite
ovdje
da biste pogledali cijelu temu.
Predmet: