Kako pohitriti izvajanje?

Pomoč pri izdelavi makrov
Odgovori
PaPaDiZ
Prispevkov: 26
Pridružen: Pe Maj 11, 2007 7:01 am

Kako pohitriti izvajanje?

Odgovor Napisal/-a PaPaDiZ »

Na drugem listu("Sheet2") v stolpcu A imam zaporedne datume (približno 53000 vrstic), v stolpcu B pa imam posamezne vrednosti. Na prvem listu("Sheet1") imam v stolpcu A samo nekatere datume(približno 3000 vrstic), ki so sigurno tudi na drugem listu. Napisal sem makro, ki datumom na prvem listu v stolpec B pripiše pripadajočo vrednost iz drugega lista ki je ob enakem datumu, vendar je izvajanje zelo počasno. A se da zadevo pohitriti?

Hvala

Koda: Izberi vse

Sub ttt()

Dim x As Long

For i = 1 To 3000
    x = Sheets("Sheet1").Range("A" & i).Value
        For k = 1 To 53133
            If Sheets("sheet2").Range("A" & k).Value = x Then
                Sheets("Sheet1").Cells(i, 2).Value = Sheets("Sheet2").Cells(k, 1).Offset(0, 1).Value
            End If
        Next k
Next i
End Sub
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Kako pohitriti izvajanje?

Odgovor Napisal/-a admin »

Pozdravljeni,

seveda se da zadevo zelo pohitriti :)... Poglejte si MExcel...

Vaš osnovni problem je v dejstvu da imate dve zanki, ki se vrtita po omenjenih območjih. Nekaj časa bi pridobili že s tem, ko bi notranjo zanko prekinili, če vrednost najdete, tako pa se v vašem primeru program zanka 3000*53133, kar pomeni 159.399.000 ~ 160 MILIONOV!!!!!

Rešitvi sta dve:
  • Ali oba stolpca sortirate in potem berete vzporedno, saj veste, da je naslednja vrednost zagotovo večja od trenutno prebrane...
  • Druga opcija pa je, da vseh 53.000 vrednosti preberete v interno strukturo 'Dictionary' in potem vrednost poiščete v tej strukturi
V vsakem primeru boste izvajanje zelo (zelo!) pohitrili...
lp,
Matjaž Prtenjak
Administrator
PaPaDiZ
Prispevkov: 26
Pridružen: Pe Maj 11, 2007 7:01 am

Re: Kako pohitriti izvajanje?

Odgovor Napisal/-a PaPaDiZ »

admin napisal/-a:.
[*]Druga opcija pa je, da vseh 53.000 vrednosti preberete v interno strukturo 'Dictionary' in potem vrednost poiščete v tej strukturi[/list]
V vsakem primeru boste izvajanje zelo (zelo!) pohitrili...

In kako se to naredi oz. uporabi. Nekaj sem poizkušal, vendar mi ne rata.

Hvala
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Kako pohitriti izvajanje?

Odgovor Napisal/-a admin »

Pozdravljeni,

tole pa je malce preobširno za forum, lahko pa vam pošljem kar VBA razred s trivialno preprosto uporabo,ki vam bi omogočil 1200x pohitritev kode.

Vaša koda se na testnem računalniku izvaja 40 MINUT!

Koda: Izberi vse

Sub ttt()
  Dim x As Long, i, k
  
  For i = 1 To 3000
      x = Sheets("List1").Range("A" & i).Value
          For k = 1 To 53133
              If Sheets("List2").Range("A" & k).Value = x Then
                  Sheets("List1").Cells(i, 2).Value = Sheets("List2").Cells(k, 1).Offset(0, 1).Value
              End If
          Next k
  Next i
End Sub

Sub test()
  Dim start As Long
  
  start = Timer
  ttt
  MsgBox Timer - start
End Sub
Koda z mojim razredom, pa samo dve sekundi!! Pohitritev je torej iz 4200s na 2s ;)

Koda: Izberi vse

Sub isci()
  Dim slv As New Slovar
  Dim k As Long
  
  With Worksheets("List2")
    For k = 1 To 53133
      slv.DodajVrednost .Cells(k, 1).Value, .Cells(k, 2).Value
    Next k
  End With
  
  With Worksheets("List1")
    For k = 1 To 3000
      .Cells(k, 2) = slv.Vrednost(.Cells(k, 1))
    Next k
  End With
End Sub

Sub test()
  Dim start As Long
  
  start = Timer
  isci
  MsgBox Timer - start
End Sub
lp,
Matjaž Prtenjak
Administrator
PaPaDiZ
Prispevkov: 26
Pridružen: Pe Maj 11, 2007 7:01 am

Re: Kako pohitriti izvajanje?

Odgovor Napisal/-a PaPaDiZ »

admin napisal/-a:Pozdravljeni,

tole pa je malce preobširno za forum, lahko pa vam pošljem kar VBA razred s trivialno preprosto uporabo,ki vam bi omogočil 1200x pohitritev kode.

Vaša koda se na testnem računalniku izvaja 40 MINUT!

Koda: Izberi vse

Sub ttt()
  Dim x As Long, i, k
  
  For i = 1 To 3000
      x = Sheets("List1").Range("A" & i).Value
          For k = 1 To 53133
              If Sheets("List2").Range("A" & k).Value = x Then
                  Sheets("List1").Cells(i, 2).Value = Sheets("List2").Cells(k, 1).Offset(0, 1).Value
              End If
          Next k
  Next i
End Sub

Sub test()
  Dim start As Long
  
  start = Timer
  ttt
  MsgBox Timer - start
End Sub
Koda z mojim razredom, pa samo dve sekundi!! Pohitritev je torej iz 4200s na 2s ;)

Koda: Izberi vse

Sub isci()
  Dim slv As New Slovar
  Dim k As Long
  
  With Worksheets("List2")
    For k = 1 To 53133
      slv.DodajVrednost .Cells(k, 1).Value, .Cells(k, 2).Value
    Next k
  End With
  
  With Worksheets("List1")
    For k = 1 To 3000
      .Cells(k, 2) = slv.Vrednost(.Cells(k, 1))
    Next k
  End With
End Sub

Sub test()
  Dim start As Long
  
  start = Timer
  isci
  MsgBox Timer - start
End Sub
Najlepša hvala za vašo pomoč. Sem se pa kasneje sam poigračkal z vsemi vašimi rešitvami, ki ste mi jih predlagal. (prekinitev zanke, vzporedno branje) in prišel sm do zanimivih razlik zanmive razlike. Rešitev z vzporednim branjem je res hitra 2,8 sekund. Sem pa na netu našel rešitev z strukturo Dictionary in je kot ste rekel zelo hitra, za omenjen primer 0,2 sekunde. Prilagam rešitev.

Koda: Izberi vse

Sub test()
    Dim a, i As Long
    Dim TimeStart As Single, TimeEnd As Single
    
    TimeStart = Timer
    
    a = Sheets("Sheet2").Range("A1").CurrentRegion.Resize(, 2).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            .Item(a(i, 1)) = a(i, 2)
        Next
        a = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 3).Value
        For i = 1 To UBound(a, 1)
            If .exists(a(i, 1)) Then a(i, 2) = .Item(a(i, 1))
        Next
        
    End With
    Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 3).Value = a
    
    TimeEnd = Timer
    timetester = TimeEnd - TimeStart
    MsgBox timetester
    
End Sub
Odgovori