[es] - VBA excel zadatak!

c0de
Aleksej Slobodnjikov
Pc Serviser
Moskow

Član broj: 190673
Poruke: 66
*.bratunac.zona.ba.

Profil

^{09.10.2008. u 00:00 - pre 201 meseci}

Evo jedan ispitni zadatak koji nisam mogao da rijesim.

Prvo pogledajte sliku.

1.Postaviti visinu redova na 10,postaviti sirinu kolone na 2.57

Na slici se vidi da je potrebno prvo napraviti formu preko koje ce se unositi Range za kreiranje table

Gore lijevo(u ovom primjeru C3)
Dole Desno(u ovom primjeru x20)

Na formi je potrebno kreirat i textbox "pocetna" koji ce oznaciti pocetak kretanja LOVCA.
Potrebno je kad se na formi klikne START da Lovac krene od pocetnog mjesta(mjesto koje mi biramo) i da ostavlja za sobom tragove broje 1.2.3.4.5.7.....

pocetni smjer je "gore desno" kada dodje do kraja tabele treba da promjeni smjer kretanja na "dole desno" a zatim "dole lijevo"....

Znam da je fazon u Offset komandi ali ne znam kako da pokrenem lovca.Potrebno je da se koristi i "IF" jer kad stigne do kraja kreirane tabele mora da promjeni smjer koji sam naveo.

EVO DOKLE SAM JA STIGAO:
Vjezba.xls

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Član broj: 25683
Poruke: 2286
*.bisinter.net.

Sajt: www.gowi.rs

+112 Profil

Re: VBA excel zadatak!

^{28.10.2008. u 07:55 - pre 200 meseci}

Svaki zadatak može da se reši na razne načine. Ali evo kratko analiza kretanja lovca
1. Prva pozicija lovca je početna pozicija. To već imaš u kodu rg2.Activate.To je sad ActiveCell
2. Granice ploče (red i kolona) možemo odrediti na osnovu unetih vrednosti za GoreLevo i DoleDesno
rwStart = rg.Row
rwEnd = rg1.Row
clStart = rg.Column
clEnd = rg1.Column
3.Za kretenje lovca kreiraš petlju. Koju tip petlje (Do ... Loop ili For ... Next) je bolje koristiti zavisi od uslova kad se kretanje lovca završava. Aktiviranjem naredne ćelije na putanji lovca dobićemo sledeći potez. Tako ActiveCell uvek određuje trenutnu poziciju lovca.
4. Za trenutnu poziciju lovca (ActiveCell) možemo odrediti red i kolonu
rwT = ActiveCell.Row
clT = ActiveCell.Column
5. Neka je rwOff i clOff pomeraj po redovima i kolonama u odnosu na prethodnu poziciju. Ispred petlje stavi da je: clOff = 1 i
rwOff = 1. Za sledeću pozicija lovca proverimo da li bi ga pomeraj izveo van granica. Ako da onda menjamo smer, tj. pomeraj će imati suprotni znak u odnosu na prethodni
If (rwT + rwOff > rwEnd) Or (rwT + rwOff < rwEnd) Then
rwOff = - rwOff
End If
i slično za pomeraj po kolonama
6. Kad smo to izračnali sledeći potez je:
ActiveCell.Offset(rwOff, clOff).Activate
7. Formatiraš aktivnu ćeliju kako treba da se prikaže trag i opet opet na početak petlje - 3.

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu

Eurora3D Team
Nebojsa - Programer & Vodja tima
Beograd

Član broj: 120376
Poruke: 900
195.252.105.*

+7 Profil

Re: VBA excel zadatak!

^{29.10.2008. u 10:16 - pre 200 meseci}

Ovako
Dodao sam ti kod za pomeranje (deo ispod komentara). Prekopiraj ceo modul ... mozda sam jos nesto menjao
poz

Code:

Option Explicit

Sub LOVAC()
Dim wb As Workbook
Dim rg As Range
Dim rg1 As Range
Dim rg2 As Range
Dim i As Byte
Dim j As Byte

Set wb = ThisWorkbook
'pre pokretanja komande start morate unjeti polja ova tri polja ispod,kako nebi doslo do greske u kodu.
Set rg = wb.Worksheets("sheet1").Range(Lovac_frm.Gore_levo)
Set rg1 = wb.Worksheets("sheet1").Range(Lovac_frm.Dole_desno)
Set rg2 = wb.Worksheets("sheet1").Range(Lovac_frm.Pocetna_pozicija)
rg2.Activate

wb.Worksheets("sheet1").Cells.Clear
wb.Worksheets("sheet1").Cells.RowHeight = 10
wb.Worksheets("sheet1").Cells.ColumnWidth = 2.57

Range(rg, rg1).Interior.Color = RGB(255, 0, 0)
Range(rg.Offset(1, 1), rg1.Offset(-1, -1)).Cells.Clear

' OVO ISPOD JE DODATO
If rg2.Row <= rg.Row Or rg2.Row >= rg1.Row Or rg2.Column <= rg.Column Or rg2.Column >= rg1.Column Then 'nije u polju
MsgBox "Pocetna pozicija nije u okviru zadatog polja ! Upisite drugu vrednost"

Else 'ako je u polju
Dim n As Integer
n = 0
'gore desno
While (rg2.Row > rg.Row + 1 And rg2.Column < rg1.Column - 1)
n = n + 1
rg2.Value = n
rg2.Interior.Color = RGB(0, 255, 255)
Set rg2 = rg2.Columns.Offset(-1, 1)
Wend
'dole desno
While (rg2.Row < rg1.Row - 1 And rg2.Column < rg1.Column - 1)
n = n + 1
rg2.Value = n
rg2.Interior.Color = RGB(0, 255, 255)
Set rg2 = rg2.Columns.Offset(1, 1)
Wend
'dole levo
While (rg2.Row < rg1.Row - 1 And rg2.Column > rg.Column + 1)
n = n + 1
rg2.Value = n
rg2.Interior.Color = RGB(0, 255, 255)
Set rg2 = rg2.Columns.Offset(1, -1)
Wend
'gore levo
While (rg2.Row > rg.Row And rg2.Column > rg.Column)
n = n + 1
rg2.Value = n
rg2.Interior.Color = RGB(0, 255, 255)
Set rg2 = rg2.Columns.Offset(-1, -1)
Wend

End If 'ako je u polju

End Sub

http://www.eurora3d.com/es/Vjezba.xls

HomePage http://www.eurora3d.com

Odgovor na temu