NYARCH piše
Želim da Excel kopira cijeli redak u novi Excel radni list na temelju unosa u ćeliju. Na primjer, imam podatke u ćelijama A8: AG8, želim da Excel kopira cijeli redak na list "a" ako je vrijednost u H8 "ir", a list "b" ako je vrijednost u H8 "RR". Najsloženiji dio, a ne samo kopiran, trebam ga kopirati u sljedeći prazan redak na radnom listu. Od oko 150 redaka, samo će se oko 15 svake vrste zapravo kopirati na novi list.
MrExcel će dodijeliti 50 bonus bodova svakom čitatelju koji se sjeća članka iz časopisa Lotus koji nudi 10 sjajnih savjeta, a savjet br. 4 bio je "Upotrijebite tipku Kraj za pomicanje na kraj dometa". Vraćajući se u Lotusove dane, možete postaviti stanični pokazivač bilo gdje u bloku podataka, pritisnuti END pa dolje, a pokazivač ćelije voziti do kraja raspona. Excel ima sličnu funkcionalnost, VBA ima sličnu funkcionalnost, a to je ključ za pronalaženje posljednjeg reda podataka na listu.
VBA tehnika je upotreba kraja (xlDown) za simulaciju tipke Kraj + dolje ili Kraj (xlUp) za simuliranje tipke Kraj + gore. Pritiskom na ovaj niz tipki pomaknut će se pokazivač ćelije na sljedeći rub neprekinutog raspona podataka. Zamislite da postoje vrijednosti u A1: A10 i A20: A30. Start u A1. Pritisnite End + Down i pokazivač ćelije se pomiče na A10. Pritisnite End + Down i prelazite na A20, koji je gornji rub sljedećeg susjednog raspona podataka. Pritisnite End + Down i prijeći ćete na A30. Zapravo se gubim kako objasniti ovo ponašanje na jednostavnom engleskom jeziku. Samo probajte pa ćete vidjeti kako to funkcionira.
Trik koji koristim je započeti od stupca A u zadnjem redu proračunske tablice, a zatim pritisnuti End + Up. Ovo će me odvesti do posljednjeg reda s podacima. Tada znam koristiti sljedeći redak prema dolje kao prazan red.
Evo grube makronaredbe koja će riješiti ovotjedni problem. Da, to biste sigurno mogli učiniti elegantnije s automatskim filtrom. Podaci su trenutno na Sheet1, s naslovima u retku 2.
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Range("A65536").End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Range("H" & x).Value If ThisValue = "ir" Then Range("A" & x & ":AG" & x).Copy Sheets("a").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Range("A" & x & ":AG" & x).Copy Sheets("b").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubS obzirom na to da Excel 2007 ima više od 65.536 redaka, mogli biste koristiti ovu makronaredbu kako bi bila kompatibilna s naprijed. Imajte na umu da ovdje koristim STANICE (redak, stupac) umjesto RANGE:
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Cells(x, 8).Value If ThisValue = "ir" Then Cells(x, 1).Resize(1, 33).Copy Sheets("a").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Cells(x, 1).Resize(1, 33).Copy Sheets("b").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubSavjete o korištenju makronaredbe potražite u odjeljku Uvod u Excel VBA Editor.
