Gjoreski 14.01.2019 14:17
Predmet:Re: Kako da obrisem redove sa markiranim celijama

da zameni ih sa long

Avko 14.01.2019 15:38
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Jesi isprobao primjer od Gjoreskog?
ako jesi i radi to je to a ako jesi i opet se smrzne probaj ovo:

na pocetku svake funkcije ubaci ovo:

PreuzmiIzvorni kôd (Text):
  1. With Application
  2.         .Calculation = xlCalculationManual
  3.         .ScreenUpdating = False
  4. End With

a na kraju svake funkcije ubaci ovo:

PreuzmiIzvorni kôd (Text):
  1. With Application
  2.         .Calculation = xlCalculationAutomatic
  3.         .ScreenUpdating = True
  4.     End With

ili ovo
na pocetku:

PreuzmiIzvorni kôd (Text):
  1. With Application
  2.         .Calculation = xlCalculationManual
  3.         .ScreenUpdating = False
  4.         .EnableEvents = False
  5.     End With

na kraju:
PreuzmiIzvorni kôd (Text):
  1. With Application
  2.         .Calculation = xlCalculationAutomatic
  3.         .ScreenUpdating = True
  4.         .EnableEvents = True
  5.     End With

mozda ti se excel nije smrznuo vec se zaglavio u nekoj petlji. Mozda je naisao na praznu celiju ili nesto sto ne odgovara uvjetima koji su zadani. Ako napise not response ili tako nesto pritisni Ctrl+Break
zaustavice se izvrsavanje koda i stat ce na mjestu gdje se zaglavio. Provjeri celiju koju trenutno obraduje ili red pa ju isto tako provjeri u Listu, sta se u njoj nalazi

mozda bi treblao upisati dio koda koji provjerava dali je celija prazna:
Do While (Cells(lRow, "A") <> "") ili tako nesto da se osiguramo da ne zaglavi.

Mozda nam se cini ponekada da se excel smrznuo no on naporno radi pa zato upotrebljavamo nesto od sljedeceg kod brisanja puno redova kao preventiva od smrzavanja:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
rngCopyRangeVisible.EntireRow.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

White Man 14.01.2019 18:32
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Kad sam zamenio sa long radi malo duze, vidim vise redova kako markira i onda zamrze, a ovo druo kad god ubacim nesto ibaci mi gresku u kodu. Jel mozete da zameniti gde sve treba pa da nakacite ceo kod? Hvala unapred

Avko 14.01.2019 18:43
Predmet:Re: Kako da obrisem redove sa markiranim celijama

prvo kad se zabijeli stisnuti ctrl+break da vidimo gdje se zaustavilo

Avko 14.01.2019 20:49
Predmet:Re: Kako da obrisem redove sa markiranim celijama

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 Long
  17.     Dim LTestLoop As Long
  18.     Dim LClearRange As String
  19.     Dim Lrows As Long
  20.     Dim Lcol As Long
  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.     With Application
  32.         .Calculation = xlCalculationManual
  33.         .ScreenUpdating = False
  34.     End With
  35.  
  36.     'Lrows=zadnjiRed
  37.     With ActiveSheet
  38.         Lrows = .Cells(Rows.count, "A").End(xlUp).Row
  39.         Lcol = .Cells(1, Columns.count).End(xlToLeft).Column
  40.     End With
  41.  
  42.     LLoop = 2
  43.  
  44.     'obrisi boje ispune
  45.     LClearRange = "A2:B" & Lrows
  46.     Range(LClearRange).Interior.ColorIndex = xlNone
  47.  
  48.     'provjeri sve redove
  49.     While LLoop <= Lrows
  50.         LChangedValue = "A" & CStr(LLoop)
  51.         LChangedValueB = "B" & CStr(LLoop)
  52.         If Len(Range(LChangedValue).Value) > 0 Then
  53.  
  54.          'Nadi jedinstvenu vrijednost
  55.          LTestLoop = 2
  56.          While LTestLoop <= Lrows
  57.             If LLoop <> LTestLoop Then
  58.                LTestValue = "A" & CStr(LTestLoop)
  59.                LTestValueB = "B" & CStr(LTestLoop)
  60.                'vrijednost je duplikat u drugoj celiji
  61.                If (Range(LChangedValue).Value = Range(LTestValue).Value) And (Range(LChangedValueB).Value = Range(LTestValueB).Value) Then
  62.                   'postavi crvenu boju pozadine u A stupcu
  63.                   Range(LChangedValue).Interior.ColorIndex = 3
  64.                   Range(LTestValue).Interior.ColorIndex = 3
  65.  
  66.                   'postavi crvenu boju pozadine u B stupcu
  67.                   'ovo netreba
  68.                   Range(LChangedValueB).Interior.ColorIndex = 3
  69.                   Range(LTestValueB).Interior.ColorIndex = 3
  70.                End If
  71.             End If
  72.             LTestLoop = LTestLoop + 1
  73.             Wend
  74.         End If
  75.         LLoop = LLoop + 1
  76.     Wend
  77.     obojiDuplikate = True
  78.  
  79.     With Application
  80.         .Calculation = xlCalculationAutomatic
  81.         .ScreenUpdating = True
  82.     End With
  83.  
  84. End Function
  85.  
  86. Function obrisiDuplikate() As Boolean
  87.     obrisiDuplikate = False
  88.    
  89.     Dim rCell As Range
  90.     Dim rRange As Range
  91.     Dim lCount As Long
  92.      
  93.  
  94.     With Application
  95.         .Calculation = xlCalculationManual
  96.         .ScreenUpdating = False
  97.     End With
  98.  
  99.     Set rRange = Range("A1", Range("A" & Rows.count).End(xlUp))
  100.     lCount = rRange.Rows.count
  101.      
  102.     For lCount = lCount To 1 Step -1
  103.         With rRange.Cells(lCount, 1)
  104.             If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
  105.                 .EntireRow.Delete
  106.             End If
  107.         End With
  108.     Next lCount
  109.     obrisiDuplikate = True
  110.  
  111.     With Application
  112.         .Calculation = xlCalculationAutomatic
  113.         .ScreenUpdating = True
  114.     End With
  115.  
  116. End Function

Avko 15.01.2019 10:27
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Jos jedno pitanje:

Sadrze li celije neke formule , tipa: =sum() ili nesto slicno?

White Man 15.01.2019 10:54
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Nece da radi ovaj kod, odmah izbaci gresko

White Man 15.01.2019 11:07
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Nece da mi prihvati sliku da nakacim ne znam sto, kako ubacim pise da vec postoji i da trebam da izbrisem, probao sam i ime da promenim i format ali opet nece a nije ni velika 200KB. Kao gresku pokaze na broju 70 Enf if i markirano je zuto, ispod njega na broju 71 je jos jedno End if. Da ne trebam da obrisem jedno?
Prilozi:
Untitled.png (Velicina datoteke:500.98 KB)

White Man 15.01.2019 11:12
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Evo sad je prihvatilo sliku. Nema funkcije ni formule, to je lager lista ima naziv artikla, model, boja, cena, stara cena, nova cena, planirana i jos neke kolone. Jel moze uslovno da pokaze duplikate sa vise kolona? Na primer da pokaze duplikate redova koji imaju iste kolone na primer naziv, model, stara cena. Hvala unapred

Gjoreski 15.01.2019 12:20
Predmet:Re: Kako da obrisem redove sa markiranim celijama

Postavi primer od tog excela