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.

broj1broj2broj3broj4broj5broj6
red111125263943
red211324263339
red331217273438
red4121723243339
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.

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.

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.

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:24
Predmet:Re:VBA ubrzanje petlje

PreuzmiIzvorni kôd (Visual Basic):
  1. 'PRONALAZI ZADNJI RED
  2. Function zadnji_red(sh As Worksheet)
  3.  
  4.     On Error Resume Next
  5.     zadnji_red = sh.Cells.Find(what:="*", _
  6.                             After:=sh.Range("A1"), _
  7.                             LookAt:=xlPart, _
  8.                             LookIn:=xlFormulas, _
  9.                             SearchOrder:=xlByRows, _
  10.                             SearchDirection:=xlPrevious, _
  11.                             MatchCase:=False).Row
  12.     On Error GoTo 0
  13. End Function
  14. Function kombinacije()
  15. Dim i As Integer, n As Integer, m As Integer, z As Integer, Broj_Redova As Integer
  16. Dim sit As Worksheet
  17.  
  18. Dim a As Single
  19. a = Timer
  20. Set sit = ActiveSheet
  21. Broj_Redova = zadnji_red(sit)
  22. sit.Range("L1:O" & Broj_Redova).ClearContents
  23. 'Broj_Redova = 5500
  24. ReDim podaci(Broj_Redova, 6) As Integer
  25.  
  26. For i = 1 To Broj_Redova
  27.     For n = 1 To 6
  28.     podaci(i, n) = Cells(i, n)
  29.     Next n
  30. Next i
  31. For i = 1 To Broj_Redova - 1
  32.      For z = i + 1 To Broj_Redova
  33.         broj_istih = 0
  34.         For n = 1 To 6
  35.             For m = 1 To 6
  36.                 If podaci(i, n) = podaci(z, m) Then
  37.                 broj_istih = broj_istih + 1
  38.                 Exit For
  39.                 End If
  40.             Next m
  41.             If n - broj_istih > 1 Then
  42.             Exit For
  43.             End If
  44.         Next n
  45.                 If broj_istih = 5 Then
  46.                 Cells(i, 13) = Cells(i, 13) & z & ","
  47.                 Cells(z, 13) = Cells(z, 13) & i & ","
  48.                 ElseIf broj_istih = 6 Then
  49.                 Cells(i, 15) = Cells(i, 15) & z & ","
  50.                 Cells(z, 15) = Cells(z, 15) & i & ","
  51.                 End If
  52.      Next z
  53.  
  54. Next i
  55. MsgBox (Timer - a)
  56. 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?