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 kopirati sve vrijednosti između MIN i MAX u Excelu sa VBA Macro, how to copy range between MIN and MAX values

Kako kopirati sve podatke
između MIN i MAX u Excelu




Kopiranje svih vrijednosti u rasponu između MIN i MAX brojeva

U ovom tutorijalu (kojeg je autor neptuncokg) pojasnit ću kako možemo kopirati određene vrijednosti nekog raspona podataka a uvjeti su nam MIN i MAX vrijednosti u datom rasponu (range).

Za početak uočite situaciju na slici ispod. Imamo raspon podataka (range) A2:B20. U stupcu A nam se nalaze nekakve brojevne vrijednosti koje će nam biti uvjet (MIN i MAX) a u stupcu B imamo podatke koje nam Excel treba vratiti kao rezultat pripadajućih traženih vrijednosti a taj rezultat želimo imati u stupcu G.

Uočite dva buttona, Copy i Forma.

Button COPY za uvjete MIN i MAX u ovom Excel primjeru  koristi uvjete iz ćelija E1 i E2. Na osnovu tih uvjeta kopira podatke iz stupca B u stupac G.

Button FORMA otvara formular-obrazac (forms) u kojem trebamo upisati MIN i MAX uvjete.

COPY button

Ovaj button poziva VBA Macro koji se nalazi u Module1

Macro (Makronaredba) u Module1 ima slijedeći Macro code

---------------------------------------
Sub Kopiraj()

Application.ScreenUpdating = False

Sheets(1).Range("G1:G20").ClearContents
'prazni stupac G

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

rp = Sheets(1).Range("E1").Value
'MIN
rz = Sheets(1).Range("E2").Value
'MAX
Set rng = Sheets(1).Range("A2:A20")
'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("B" & rpRow & ":" & "B" & rzRow).Copy
'PODRUCJE ZA KOPIRANJE
Range("G1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
'ukida kopiranje

Set rng = Nothing
'oslobadja varijablu rng

End Sub
----------------------------------

U Module2 nalazi se slijedeći Macro code, a vezan je uz FORMA button

Sub Forma()
UserForm1.Show
End Sub

U ThisWorkbook nalazi se slijedeći Macro (koji predstavlja događaj prilikom pokretanja same Workbook tj. datoteke) a koji nije nužan, tj. nepotreban je, a pokreće Formu nakon učitavanja dateoteke Excela. U koliko želite da vam se ne pokrene Forma automatski obrišite ovaj Macro tj. nemojte ga niti umetati u ThisWorkbook

Private Sub Workbook_Open()
UserForm1.Show
End Sub

Dakle ovo je Forma koja nam se pokreće prilikom otvaranja datoteke (Workbook) a u nju upisujemo (unosimo) uvjete tj. MIN i MAX vrijednost (broj) a klikom na button UNOS rezultati nam se pojavljuju u polju "Rezultat"  kao i to da se isti rezultati kopiraju u stupac "G". IFormu zatvaramo klikom na button IZLAZ.

Form u Excelu

Sama Forma se obrađuje u VBE modulu "UserForm1" gdje možete mijenjati osnovne postavke izgleda formulara (forme). Naravno uključite okvir za prikazivanje "Properties" za formu

.



Klikom Desnom tipkom miša na sam naziv modula "UserForm1" pa potom "View Code" pojavljuje vam se Macro kod koji izvršava naredbe po postavljenim uvjetima.

Makronaredba (Macro) za FORM button nalazi se ispod. Uočite da se ovaj Macro sastoji od više VBA procedura

Private Sub cmdIzlaz_Click()
Unload Me
End Sub

Private Sub cmdUnos_Click()

Sheets(1).Range("G1:G20").ClearContents
'prazni stupac G
Sheets(1).Range("E1:E2").ClearContents
'prazni MIN i MAX

If txtMIN.Value = "" Or txtMAX.Value = "" Or (Val(txtMIN.Value) > Val(txtMAX.Value)) Then Exit Sub
'KONTROLISE UNOS

Sheets(1).Range("E1").Value = txtMIN.Value
'UNOS U SHEET
Sheets(1).Range("E2").Value = txtMAX.Value
'UNOS U SHEET

Application.ScreenUpdating = False

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

rp = Sheets(1).Range("E1").Value
'MIN
rz = Sheets(1).Range("E2").Value
'MAX
Set rng = Sheets(1).Range("A2:A20")
'PODRUCJE PRETRAGE

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

Sheets(1).Activate
'activira Sheet-1, ako nije aktivan

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

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

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

Application.CutCopyMode = False
'ukida kopiranje

Set rng = Nothing
'oslobadja varijablu rng

Dim xy As Integer
xy = Sheets("Sheet1").Range("G20").End(xlUp).Row
lst1.RowSource = "Sheet1!G1:G" & xy

End Sub

Private Sub txtMIN_Change()
If Not IsNumeric(txtMIN.Value) Then txtMIN.Value = ""
'SAMO NUMERICKI UNOS
End Sub

Private Sub txtMAX_Change()
If Not IsNumeric(txtMAX.Value) Then txtMAX.Value = ""
'SAMO NUMERICKI UNOS
End Sub

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