IZBORNIK HOME FORUM ACCESS 2003 EXCEL 2003 WORD 2003  .
   
   
HOME
FORUM Win Tips&Tricks
   
KAKO INSTALIRATI
WINDOWS XP ?
Kako instalirati Win XP sa USB STICKA
Kako instalirati WINDOWS 7 ?
Naučite za 15 minuta raditi u Windows XP
Naučite Internet Explorer i Outlook Express
za 15 minuta
Kako kreirati BOOT CD za instalaciju Win95
   
MS OFFICE 2003
MS OFFICE 2007
   
   
HOME NETWORK
tutorijal za mreže
Network Windows 7 - XP
   
ZANIMLJIVI LINKOVI
BROJEVNI SUSTAVI
(DEC, OKT, BIN, HEX )
CMD - Command Prompt
CISCO - CCNA tutoriali
VLSM and SUBNETTING
   
Tutorijali za phpBB forum
JAVASCRIPT
VISUAL BASIC 6.0
AUTOCAD 2007
 



MICROSOFT EXCEL 2007- kako automatski sortirati pritiskom na tipku Enter - automatic list sort when press Enter

Kako automatski sortirati popis (range) po grupama i kopirati u grupe uz uvjet




Automatsko sortiranje popisa po grupama i kopiranje tj. grupiranje po grupama uz izbor MIN i MAX broja

U ovom primjeru imamo situaciju sa dva radna lista (Sheeta).

- Sheet1
- baza

U Sheetu "baza" nalaze nam se podaci (broj i ime osobe). Određenom broju pridružujemo ime neke osobe. Nakon upisa bilo kojeg broja svi podaci nam se automatski sortiraju nakon pritiska na tipku Enter. Svi podaci podijeljeni su u četiri grupe a svaka grupa ima 13 članova.

Na ranom listu "Sheet1" nalaze nam se grupe od po 13 članova u stupcima B i C koji se automatski povlače sa sheeta "baza" (linkani su). Čim promijenimo podatke na sheeetu "baza" automatski se ti podaci mijenjaju na Sheet1. Nadalje postoje granice MIN i MAX brojeva koji su nam uvjeti za filtriranje tj. kopiranje. Dakle pomoću MIN i MAX želimo sve brojeve sa pripadajućim imenima kopirati u određenu pripadajuću grupu a glavni uvjet je broje redoslijeda u sheetu "baza". jednom riječju zadatak je "kiopiraj sve brojeve i imena koji se nalaze između definiranih brojeva MIN i MAX " za svaku grupu posebno. Uz to želimo da eventualnom promjenom i naknadnim izmjenama automatski imamo promjene i u grupama na "Sheet1".

U koliko dobijete nekakvu grešku, znači da niste upisali ispravan broj za MIN ili MAX ili niste kliknuli na button COPY.

Na slijedeće tri slike uočite gore opisano

SHEET "BAZA"

Idemo prvo riješiti Sheet "baza". U njega umetnimo Macro koji se nalazi ispod slike. Ovaj Macro automatski sortira sve redove u rasponu B2:C53 prema brojevima koji se nalaze u stupcu "B" počevši sa ćelijom B2. Nakon sortiranja brojeva automatski nam se sortiraju i pripadajuća imena uz određeni broj. Redni brojevi ostaju poredani kako su i bili (uzlazno)

Makronaredba za Sheet "baza". Kopirajte ovaj VBA code direktno u Sheet "baza".
Desni klik mišem na naziv Sheeta "baza" => View Code i zalijepite makronaredbu u Window Code u VBE.

----------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

On Error Resume Next

Range("B2:C53").Select
'range za sortiranje
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Target.Offset(1, 0).Select
'pozicionira se jednu ćeliju ispod nakon promjene broja u stupcu B
Application.ScreenUpdating = True

End Sub

----------------------------------------------------

SHEET "SHEET1"

Idemo sada riješiti Sheet "Sheet1"

Ovaj Sheet1 MORA biti UVIJEK prvi po redu u radnoj knjizi (Workbook), inače neće ispravno grupirati MIN i MAX

Pomoću Macroa koji se nalaze u Module1 vršimo kopiranje prema uvjetima za MIN i MAX za svaku grupu posebno.

Dakle u Module1 umetnimo ove 4 makronaredbe (to je u stvari jedna te ista makronaredba umnožena četiri puta) a ove makronaredbe-procedure pozivamo preko buttona COPY. Ovaj Macro se može iskombinirati jednostavnije ali to ostavljam vama za istraživanje i proučavanje.
Kako se insertira Module u VBE pogledajte na linku Insert Module u VBE.

----------------------------------------------------
Sub KopirajA()

ActiveSheet.Unprotect
'ukida password na Sheetu1
Application.ScreenUpdating = False

Sheets(1).Range("I2:I14").ClearContents
'prazni prethodno kopirano na Sheet1 u rasponu I2:I14

Dim rp As Double, rz As Double, rpRow As Double, rzRow As Double
Dim aMIN As Range, aMAX As Range, rng As Range

rp = Sheets(1).Range("F1").Value
' MIN
rz = Sheets(1).Range("F2").Value
' MAX
Set rng = Sheets(1).Range("B2:B14")
'PODRUCJE PRETRAGE

If rp > rz Then Exit Sub
'ako je MIN > MAX prekida proceduru

On Error Resume Next
'ignorira gresku ako se zada nepostojeci MIN ili MAX

For Each aMIN In rng
'trazi MIN
If aMIN.Value = rp Then rpRow = aMIN.Row
'broj reda gdje je nadjen MIN
Next

For Each aMAX In rng
'trazi MAX
If aMAX.Value = rz Then rzRow = aMAX.Row
'broj reda gdje je nadjen MAX
Next

Range("C" & rpRow & ":" & "C" & rzRow).Copy
'PODRUCJE ZA KOPIRANJE
Range("I2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'PODRUCJE ZA LJEPLJENJE

Application.CutCopyMode = False
'ukida kopiranje

Set rng = Nothing
'oslobadja varijablu rng
Range("F1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'postavlja blanko password na Sheetu1
ActiveSheet.EnableSelection = xlUnlockedCells
'dozvoljava selekciju nezakljucanih celija
End Sub


Sub KopirajB()
ActiveSheet.Unprotect
'ukida password na Sheetu1
Application.ScreenUpdating = False

Sheets(1).Range("I15:I27").ClearContents
'prazni prethodno kopirano

Dim rp As Double, rz As Double, rpRow As Double, rzRow As Double
Dim aMIN As Range, aMAX As Range, rng As Range

rp = Sheets(1).Range("F15").Value
' MIN
rz = Sheets(1).Range("F16").Value
' MAX
Set rng = Sheets(1).Range("B15:B27")
'PODRUCJE PRETRAGE

If rp > rz Then Exit Sub
'ako je MIN > MAX prekida proceduru

On Error Resume Next
'ignorira gresku ako se zada nepostojeci MIN ili MAX

For Each aMIN In rng
'trazi MIN
If aMIN.Value = rp Then rpRow = aMIN.Row
'broj reda gdje je nadjen MIN
Next

For Each aMAX In rng
'trazi MAX
If aMAX.Value = rz Then rzRow = aMAX.Row
'broj reda gdje je nadjen MAX
Next

Range("C" & rpRow & ":" & "C" & rzRow).Copy
'PODRUCJE ZA KOPIRANJE
Range("I15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'PODRUCJE ZA LJEPLJENJE

Application.CutCopyMode = False
'ukida kopiranje

Set rng = Nothing
'oslobadja varijablu rng
Range("F15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'postavlja blanko password na Sheetu1
ActiveSheet.EnableSelection = xlUnlockedCells
'dozvoljava selekciju nezakljucanih celija
End Sub


Sub KopirajC()
ActiveSheet.Unprotect
'ukida password na Sheetu1
Application.ScreenUpdating = False

Sheets(1).Range("I28:I40").ClearContents
'prazni prethodno kopirano

Dim rp As Double, rz As Double, rpRow As Double, rzRow As Double
Dim aMIN As Range, aMAX As Range, rng As Range

rp = Sheets(1).Range("F28").Value
' MIN
rz = Sheets(1).Range("F29").Value
' MAX
Set rng = Sheets(1).Range("B28:B40")
'PODRUCJE PRETRAGE

If rp > rz Then Exit Sub
'ako je MIN > MAX prekida proceduru

On Error Resume Next
'ignorira gresku ako se zada nepostojeci MIN ili MAX

For Each aMIN In rng
'trazi MIN
If aMIN.Value = rp Then rpRow = aMIN.Row
'broj reda gdje je nadjen MIN
Next

For Each aMAX In rng
'trazi MAX
If aMAX.Value = rz Then rzRow = aMAX.Row
'broj reda gdje je nadjen MAX
Next

Range("C" & rpRow & ":" & "C" & rzRow).Copy
'PODRUCJE ZA KOPIRANJE
Range("
I28").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'PODRUCJE ZA LJEPLJENJE

Application.CutCopyMode = False
'ukida kopiranje

Set rng = Nothing
'oslobadja varijablu rng
Range("F28").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'postavlja blanko password na Sheetu1
ActiveSheet.EnableSelection = xlUnlockedCells
'dozvoljava selekciju nezakljucanih celija
End Sub


Sub KopirajD()
ActiveSheet.Unprotect
'ukida password na Sheetu1
Application.ScreenUpdating = False

Sheets(1).Range("I41:I53").ClearContents
'prazni prethodno kopirano

Dim rp As Double, rz As Double, rpRow As Double, rzRow As Double
Dim aMIN As Range, aMAX As Range, rng As Range

rp = Sheets(1).Range("F41").Value
' MIN
rz = Sheets(1).Range("F42").Value
' MAX
Set rng = Sheets(1).Range("B41:B53")
'PODRUCJE PRETRAGE

If rp > rz Then Exit Sub
'ako je MIN > MAX prekida proceduru

On Error Resume Next
'ignorira gresku ako se zada nepostojeci MIN ili MAX

For Each aMIN In rng
'trazi MIN
If aMIN.Value = rp Then rpRow = aMIN.Row
'broj reda gdje je nadjen MIN
Next

For Each aMAX In rng
'trazi MAX
If aMAX.Value = rz Then rzRow = aMAX.Row
'broj reda gdje je nadjen MAX
Next

Range("C" & rpRow & ":" & "C" & rzRow).Copy
'PODRUCJE ZA KOPIRANJE
Range("I41").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'PODRUCJE ZA LJEPLJENJE

Application.CutCopyMode = False
'ukida kopiranje

Set rng = Nothing
'oslobadja varijablu rng
Range("F1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'postavlja blanko password na Sheetu1
ActiveSheet.EnableSelection = xlUnlockedCells
'dozvoljava selekciju nezakljucanih celija
End Sub

----------------------------------------------------

Također insertirajmo Module2 i u njega kopirajmo Macro koji se nalazi ispod slike da bi pozvali sve četiri procedure nakon postavljanja MIN i MAX vrijednosti

Pozivanje drugih Macro procedura u Workbook

Ovaj Macro poziva procedure iz Module1 redoslijedom kako su postavljene.

-------------------
Sub Kopiranje()
Call KopirajA
'poziva proceduru A iz Module1
Call KopirajB
Call KopirajC
Call KopirajD
End Sub

-------------------



SHEET1 - FORMULE

U Sheet1 u stupcu "B" postavimo formulu =baza!B2 i kopirajmo je prema dolje do zadnjeg reda (row 53). Ili selektirajte stupac "B" na Sheetu "baza" pa na Copy, prebacimo se na Sheet1 pa => Paste Special => Paste Link. Isto to uradite i za stupac "C".

Na istom Sheetu1 obratite pažnju na stupac "D". Ovi brojevi "ljubičaste" boje su inače na završetku aplikacije obojani "bijelom" bojom da se ne vide (uočite da ih nema na drugoj i trećoj slici po redu, ovog tutorijala). On nam služe kao pomoćni element. Dakle u stupcu D upisujemo formulu =B2 što je isti podatak kao i u ćeliji B2 a služi nam da ga možemo uvrstiti u Vlookup formulu. Kopirajte formulu do kraja 53 reda a nakon toga selektirajte raspon D2:D53 i obojajte u BIJELI font

Kako automatski sortirati vrijednosti u Excelu

U stupcu H koristiti ćemo funkciju VLOOKUP. Formula koja se nalazi u stupcu "H".
=IF(I2<>"";VLOOKUP(I2;$C$2:$D$14;2;FALSE);"")

Ona nam služi da identificira pripadajući "BROJ" za dotično IME iz "baze" koje se nalazi pored nje a koje opet formira Makronaredba. Kopirajte formulu do kraja reda 14. U ovoj Vlookup formuli uočite različite raspone pretraživanja.
Za drugu grupu u istom stupcu postavite formulu =IF(I15<>"";VLOOKUP(I15;$C$15:$D$27;2;FALSE);"")
za treću grupu postavite formulu =IF(I28<>"";VLOOKUP(I28;$C$28:$D$40;2;FALSE);"")
i za četvrtu grupu =IF(I41<>"";VLOOKUP(I41;$C$41:$D$53;2;FALSE);"").
I na kraju ostaje da obojamo naše grupe (po želji) radi lakšeg uočavanja.

.



Selektirajte sve ćelije na radnom listu Sheet1 i zaključajte ih na tabu Protection, u stvari po defaultu bi trebale biti već zaključane ali ipak za svaki slučaj ako ste nešto radili sa ovom opcijom. Dakle  Select All => Format Cell => Protection tab => Locked)
Potom selektirajte sve ćelije u kojima upisujete MIn i MAX pa ih otključajte (isključite opciju Locked). Također selektirajte nekoliko ćelija u pozadini buttona COPY i otključajte ih da bi nam se kursor pozicionirao u blizini buttona nakon svih popunjavanja MIN i MAX. Kliknite na Review => Protect Sheet (blanko password). Sada ste se osigurali da nećete ništa obrisati na ovom Sheetu i da će funkcionirati sve kako treba jer nakon pritiska na tipku Enter slijedeća selektirana ćelija bit će ona u kojoj treba upisati MIN ili MAX.

Ovaj primjer može se jednostavnije riješiti i formulama.

Sheet "baza" ostaje kao u prethodnom primjeru sa makronaredbom
Sheet "Sheet1" ne sadrži nikakve Makronaredbe već formule. stupac A i B su linkani (Paste Link) sa sheeta "baza".
Razlika je da ovdje koristite ili CIJELE ili DECIMALNE brojeve (jer kombinacija nije baš najsretnije rješenje). Također trebate voditi računa da brojeve MIN i MAX upisujete iz raspona dotične grupe.

Prva formula u svakoj grupi vezana je za red u kojem se nalazi.

Tako za prvu grupu imamo formulu C2: =VLOOKUP($E$2;$A$2:$B$14;2;TRUE)
Formula ispod koja se kopira do kraja grupe glasi;
C3: =IF($E$2+ROW()-2>$F$2;"";VLOOKUP($E$2+ROW()-2;$A$2:$B$14;2;TRUE))

Isto tako za drugu grupu imamo formulu C15: =VLOOKUP($E$15;$A$15:$B$27;2;TRUE)
Formula ispod koja se kopira do kraja grupe glasi;
C16: =IF($E$15+ROW()-15>$F$15;"";VLOOKUP($E$15+ROW()-15;$A$15:$B$27;2;TRUE))

Na jednom mjestu popis svih tema vezanih za kopiranje (copy) u Excelu: Tutorijali vezani za radnje kopiranja u Excelu




©- 2006 - 2021 - IvanC  - Sva prava pridržana.  ic.ims.hr