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?
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
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...
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.
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
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
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
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.
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