iCentar » Racunari i oprema » Programirannje i baze podataka » Vb/Vbnet

Avko

13.12.2023 17:04

Predmet:VBA ubrzanje petlje

VBA je visual basic pa sam stavio ovdje, kod je inace smjesten u excel 2007

Imamo 27000 kombinacija loto sistema. Treba svaku sa svakom usporediti i traziti podudaranje u 5 i 6 brojeva.

	broj1	broj2	broj3	broj4	broj5	broj6
red1	1	11	25	26	39	43
red2	1	13	24	26	33	39
red3	3	12	17	27	34	38
red4	12	17	23	24	33	39

for red1=1 to zadnjiRed
for red2=red1+1 to zadnjiRed
for kolona1=1 to 6
for kolona2=1 to 6
...kod...
next kolona2
next kolona1
next red2
next red1

neka moja ubrzanja:

-sve sam stavio u matricu array,
- kada usporedujem ako je broj1 < broj2 izlazim iz petlje jer nema potrebe dalje usporedivati sa vecim brojevima

Kako bi vi ubrzali taj kod , meni vrti dugo to pa reko mozda ima ubrzanja. Ili cu ipak morati cekati?
Zakaco sam primjer mozda se nekome da sa time malo poigrati. Jednostavno je netreba puno razmisljat

Prilozi:
provjeriKombinacije.zip (Velicina datoteke:778.22 KB)

zxz	13.12.2023 19:56
Predmet:Re:VBA ubrzanje petlje Ovo je dvodimenzionalna matrica. Mnogo bi bolje bilo da si opisao sta zelis dobiti odnosno sto zelis provjeravati. U stvari trebas opisati sta hoces. Ja ne igram te igre pa neznam a vjerovatno ima ih jos koji neznaju. koliko ja kontam ti imas niz od 1 do 39 i trebas provjeravati koliko taj tvoj niz ima pogodaka u ovoj dvodimenzionalnoj matrici odnosno u ovoj tabeli koju si dao.

zxz

13.12.2023 19:56

Predmet:Re:VBA ubrzanje petlje

Ovo je dvodimenzionalna matrica.
Mnogo bi bolje bilo da si opisao sta zelis dobiti odnosno sto zelis provjeravati.
U stvari trebas opisati sta hoces.
Ja ne igram te igre pa neznam a vjerovatno ima ih jos koji neznaju.
koliko ja kontam ti imas niz od 1 do 39 i trebas provjeravati koliko taj tvoj niz ima pogodaka u ovoj dvodimenzionalnoj matrici odnosno u ovoj tabeli koju si dao.

Avko	14.12.2023 00:15
Predmet:Re:VBA ubrzanje petlje kad usporedis 1.red sa 2. redom dobijes da se podudaraju u 3 broja. zatim usporedujes 1.red sa 3.redom oni se ne podudaraju niti u jednom broju ide 1.red sa 4.redom oni se podudaraju u jednom broju. nakon toga ide 2.red sa 3.redom pa 2.red sa 4.redom a onda 3.red sa 4.redom treba naci koji se redovi poklapaju u 5 i 6 brojeva. nema bas veze sa lotom vise usporediti nizove brojeva 1.red inner join 2.red = 1,26,39 (3 broja) trazim red1 inner join red2 = 5 ili 6 brojeva Jeli ti sada jasnije?

Avko

14.12.2023 00:15

Predmet:Re:VBA ubrzanje petlje

kad usporedis 1.red sa 2. redom dobijes da se podudaraju u 3 broja. zatim usporedujes 1.red sa 3.redom oni se ne podudaraju niti u jednom broju ide 1.red sa 4.redom oni se podudaraju u jednom broju. nakon toga ide 2.red sa 3.redom pa 2.red sa 4.redom a onda 3.red sa 4.redom
treba naci koji se redovi poklapaju u 5 i 6 brojeva.
nema bas veze sa lotom vise usporediti nizove brojeva

1.red inner join 2.red = 1,26,39 (3 broja) trazim red1 inner join red2 = 5 ili 6 brojeva

Jeli ti sada jasnije?

zxz	14.12.2023 13:37
Predmet:Re:VBA ubrzanje petlje Posto imas nekoliko hiljada redova bilo koji kod ce raditi sporo i trajalo bi vjerovatno i sat i vise. Pogotovo sto to sve treba zapisivati koji je red sa kojim uparen sa 5 i sa 6. Mnogo je to podataka za exel. Citat: kada usporedujem ako je broj1 < broj2 izlazim iz petlje jer nema potrebe dalje usporedivati sa vecim brojevima ovo mi bas nije jasno. Kako si opisao ti usporejujes sve redove jedan sa drugim.

zxz

14.12.2023 13:37

Predmet:Re:VBA ubrzanje petlje

Posto imas nekoliko hiljada redova bilo koji kod ce raditi sporo i trajalo bi vjerovatno i sat i vise.
Pogotovo sto to sve treba zapisivati koji je red sa kojim uparen sa 5 i sa 6.
Mnogo je to podataka za exel.

Citat:

kada usporedujem ako je broj1 < broj2 izlazim iz petlje jer nema potrebe dalje usporedivati sa vecim brojevima

ovo mi bas nije jasno.
Kako si opisao ti usporejujes sve redove jedan sa drugim.

Avko	14.12.2023 13:59
Predmet:Re:VBA ubrzanje petlje kolona red1= 1, 3, 12, 20, 23, 30 red2= 1, 2, 17, 27, 30, 39 for kol1=1 to 6 for kol2=1 to 6 if broj1(red1,kol1)<broj2(red2,kol2) then exit for ' ako je broj manji nema potrebe dalje usporedivati vec se prelazi na sljedecu kol2 'npr. kada dode do broj1(1,5)=23 i broj2(red2,4)=27 ne usporedujemo i izademo iz petlje 'te prelazimo na red1,kol6 i usporedujemo sa red2,kol1 'zasto?, jer su svi ostali brojevi u red2 od kol4 do kol6 veci od broja iz red1,kol5 i nema potrebe gubiti vrijeme 'i usporedivati ostale brojeve. jeli jasnije?

Avko

14.12.2023 13:59

Predmet:Re:VBA ubrzanje petlje

kolona
red1= 1, 3, 12, 20, 23, 30
red2= 1, 2, 17, 27, 30, 39

for kol1=1 to 6
for kol2=1 to 6
if broj1(red1,kol1)<broj2(red2,kol2) then exit for
' ako je broj manji nema potrebe dalje usporedivati vec se prelazi na sljedecu kol2
'npr. kada dode do broj1(1,5)=23 i broj2(red2,4)=27 ne usporedujemo i izademo iz petlje
'te prelazimo na red1,kol6 i usporedujemo sa red2,kol1
'zasto?, jer su svi ostali brojevi u red2 od kol4 do kol6 veci od broja iz red1,kol5 i nema potrebe gubiti vrijeme
'i usporedivati ostale brojeve.

jeli jasnije?

zxz	14.12.2023 15:55
Predmet:Re:VBA ubrzanje petlje aha hoces reci da su brojevi u nizu postavljeni rastuci.

zxz

14.12.2023 15:55

Predmet:Re:VBA ubrzanje petlje

aha hoces reci da su brojevi u nizu postavljeni rastuci.

Avko	14.12.2023 18:06
Predmet:Re:VBA ubrzanje petlje je, ok nastao je drugi problem. Windows se azurirao i sada mi ne radi taj program. Kod oce ali nece prikazat formu ista stvar kao i ovdje https://icentar.ba/...tion+error reinstaliro uz zadrzavanje datoteka, sada jos moram postaviti jezik i stvoriti tocku vracanja pa nastavljamo. Ode dan bezveze

Avko

14.12.2023 18:06

Predmet:Re:VBA ubrzanje petlje

je, ok nastao je drugi problem.
Windows se azurirao i sada mi ne radi taj program. Kod oce ali nece prikazat formu ista stvar kao i ovdje

https://icentar.ba/...tion+error

reinstaliro uz zadrzavanje datoteka, sada jos moram postaviti jezik i stvoriti tocku vracanja pa nastavljamo.
Ode dan bezveze

zxz	14.12.2023 19:12
Predmet:Re:VBA ubrzanje petlje koliko ti traje ovo kada pokrenes?

zxz

14.12.2023 19:12

Predmet:Re:VBA ubrzanje petlje

koliko ti traje ovo kada pokrenes?

zxz	14.12.2023 19:24
Predmet:Re:VBA ubrzanje petlje PreuzmiIzvorni kôd (Visual Basic): 'PRONALAZI ZADNJI RED Function zadnji_red(sh As Worksheet) On Error Resume Next zadnji_red = sh.Cells.Find(what:="*", _ After:=sh.Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function kombinacije() Dim i As Integer, n As Integer, m As Integer, z As Integer, Broj_Redova As Integer Dim sit As Worksheet Dim a As Single a = Timer Set sit = ActiveSheet Broj_Redova = zadnji_red(sit) sit.Range("L1:O" & Broj_Redova).ClearContents 'Broj_Redova = 5500 ReDim podaci(Broj_Redova, 6) As Integer For i = 1 To Broj_Redova For n = 1 To 6 podaci(i, n) = Cells(i, n) Next n Next i For i = 1 To Broj_Redova - 1 For z = i + 1 To Broj_Redova broj_istih = 0 For n = 1 To 6 For m = 1 To 6 If podaci(i, n) = podaci(z, m) Then broj_istih = broj_istih + 1 Exit For End If Next m If n - broj_istih > 1 Then Exit For End If Next n If broj_istih = 5 Then Cells(i, 13) = Cells(i, 13) & z & "," Cells(z, 13) = Cells(z, 13) & i & "," ElseIf broj_istih = 6 Then Cells(i, 15) = Cells(i, 15) & z & "," Cells(z, 15) = Cells(z, 15) & i & "," End If Next z Next i MsgBox (Timer - a) End Function

zxz

14.12.2023 19:24

Predmet:Re:VBA ubrzanje petlje

PreuzmiIzvorni kôd (Visual Basic):

'PRONALAZI ZADNJI RED
Function zadnji_red(sh As Worksheet)
On Error Resume Next
zadnji_red = sh.Cells.Find(what:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function kombinacije()
Dim i As Integer, n As Integer, m As Integer, z As Integer, Broj_Redova As Integer
Dim sit As Worksheet
Dim a As Single
a = Timer
Set sit = ActiveSheet
Broj_Redova = zadnji_red(sit)
sit.Range("L1:O" & Broj_Redova).ClearContents
'Broj_Redova = 5500
ReDim podaci(Broj_Redova, 6) As Integer
For i = 1 To Broj_Redova
For n = 1 To 6
podaci(i, n) = Cells(i, n)
Next n
Next i
For i = 1 To Broj_Redova - 1
For z = i + 1 To Broj_Redova
broj_istih = 0
For n = 1 To 6
For m = 1 To 6
If podaci(i, n) = podaci(z, m) Then
broj_istih = broj_istih + 1
Exit For
End If
Next m
If n - broj_istih > 1 Then
Exit For
End If
Next n
If broj_istih = 5 Then
Cells(i, 13) = Cells(i, 13) & z & ","
Cells(z, 13) = Cells(z, 13) & i & ","
ElseIf broj_istih = 6 Then
Cells(i, 15) = Cells(i, 15) & z & ","
Cells(z, 15) = Cells(z, 15) & i & ","
End If
Next z
Next i
MsgBox (Timer - a)
End Function

Avko	18.12.2023 11:13
Predmet:Re:VBA ubrzanje petlje Redimenzionirao si matricu a da je prije toga nisi dimenzirao. => ReDim podaci(Broj_Redova, 6) As Integer To se radi tako kada neznas koliko ce biti redova ili ovo as integer odmah i dimenzionira Ja sam koristio Dim podaci() as Variant Jeli krivo radim ili tvoje stedi memoriju, a mozda nesto trece?

Avko

18.12.2023 11:13

Predmet:Re:VBA ubrzanje petlje

Redimenzionirao si matricu a da je prije toga nisi dimenzirao. => ReDim podaci(Broj_Redova, 6) As Integer
To se radi tako kada neznas koliko ce biti redova ili ovo as integer odmah i dimenzionira
Ja sam koristio Dim podaci() as Variant
Jeli krivo radim ili tvoje stedi memoriju, a mozda nesto trece?