Regouin
03-23-2005, 02:02 AM
Hi guys I am speeding up a sub and already brought it down from 8 sec to 1.3 seconds. I shall first post the VBA.
Option Explicit
Sub bepaalonderhoud()
Dim start, finish, totaltime
start = Timer
'initialiseren listbox
With lbox1
.ColumnCount = 1
.ColumnWidths = 180
.Width = 200
.Height = 15
.Visible = False
End With
'leegmaken listbox en het lettertype van kolom A resetten naar niet-vet en 10 pts
lbox1.Clear
Worksheets("hoofd").Range("a7:a65536").Formula = ""
'eerste item listbox is 1
Me.lbox1.AddItem "1"
'rijnummers onderdelen opslaan in de listbox
Dim ws As Worksheet, cel As Range, rng As Range, firstAddy As String
Set ws = Worksheets("onderhoud")
Set rng = ws.Range("b1:b" & ws.Range("b65536").End(xlUp).Row)
With rng
Set cel = .Find("Onderdeel", LookIn:=xlValues, _
searchorder:=xlByRows, SearchDirection:=xlNext, LookAt:=xlPart, MatchCase:=False)
If Not cel Is Nothing Then
firstAddy = cel.Address
Do
Me.lbox1.AddItem cel.Row
Set cel = .FindNext(cel)
Loop Until cel Is Nothing Or cel.Address = firstAddy
End If
End With
'laatste item listbox is het rijnummer van "einde"
Set ws = Worksheets("onderhoud")
Set rng = ws.Range("a1:a" & ws.Range("a65536").End(xlUp).Row)
With rng
Set cel = .Find("Einde", LookIn:=xlValues, _
searchorder:=xlByRows, SearchDirection:=xlNext, LookAt:=xlPart, MatchCase:=False)
Me.lbox1.AddItem cel.Row
End With
'voor ieder onderdeel de taken bepalen en indien een taak moet gebeuren "ohoudtoev" aanroepen
Dim i As Long
Dim j As Long
Dim StartI As Long
Dim EindI As Long
Dim RangeHI As Range
j = 0
Do
StartI = lbox1.List(j, 0)
EindI = lbox1.List(j + 1, 0) - 1
For i = StartI To EindI
Set RangeHI = Worksheets("onderhoud").Range("H" & i)
If RangeHI.Value <> "" Then
Call ohoudtoev(i)
End If
Next i
j = j + 1
Loop Until j = lbox1.ListCount - 1
'alle rijen automatisch resizen
Worksheets("hoofd").Rows.AutoFit
Worksheets("hoofd").Range("A1").Select
finish = Timer
totaltime = finish - start
MsgBox (totaltime)
End Sub
Private Sub ohoudtoev(ByVal rij As Long)
Dim i As Long
Dim RangeAI As Range
Dim RangeHI As Range
Dim RangeBI As Range
Set RangeHI = Worksheets("onderhoud").Range("A" & rij)
Set RangeBI = Worksheets("onderhoud").Range("B" & rij)
'eerstvolgende lege cel zoeken op de eerste sheet
With Worksheets("hoofd")
i = 6
Do
i = i + 1
Loop Until .Range("A" & i) = ""
Set RangeAI = .Range("A" & i)
End With
'wegschrijven tekst
RangeHI.Copy
RangeAI.Select
ActiveSheet.Paste
End Sub
But later on it will import more data and it is going to take longer, and what loop is faster the
i = a
do
i = i+1
loop until i = b
or the
for i is a to b
next i
TIA
frank
Option Explicit
Sub bepaalonderhoud()
Dim start, finish, totaltime
start = Timer
'initialiseren listbox
With lbox1
.ColumnCount = 1
.ColumnWidths = 180
.Width = 200
.Height = 15
.Visible = False
End With
'leegmaken listbox en het lettertype van kolom A resetten naar niet-vet en 10 pts
lbox1.Clear
Worksheets("hoofd").Range("a7:a65536").Formula = ""
'eerste item listbox is 1
Me.lbox1.AddItem "1"
'rijnummers onderdelen opslaan in de listbox
Dim ws As Worksheet, cel As Range, rng As Range, firstAddy As String
Set ws = Worksheets("onderhoud")
Set rng = ws.Range("b1:b" & ws.Range("b65536").End(xlUp).Row)
With rng
Set cel = .Find("Onderdeel", LookIn:=xlValues, _
searchorder:=xlByRows, SearchDirection:=xlNext, LookAt:=xlPart, MatchCase:=False)
If Not cel Is Nothing Then
firstAddy = cel.Address
Do
Me.lbox1.AddItem cel.Row
Set cel = .FindNext(cel)
Loop Until cel Is Nothing Or cel.Address = firstAddy
End If
End With
'laatste item listbox is het rijnummer van "einde"
Set ws = Worksheets("onderhoud")
Set rng = ws.Range("a1:a" & ws.Range("a65536").End(xlUp).Row)
With rng
Set cel = .Find("Einde", LookIn:=xlValues, _
searchorder:=xlByRows, SearchDirection:=xlNext, LookAt:=xlPart, MatchCase:=False)
Me.lbox1.AddItem cel.Row
End With
'voor ieder onderdeel de taken bepalen en indien een taak moet gebeuren "ohoudtoev" aanroepen
Dim i As Long
Dim j As Long
Dim StartI As Long
Dim EindI As Long
Dim RangeHI As Range
j = 0
Do
StartI = lbox1.List(j, 0)
EindI = lbox1.List(j + 1, 0) - 1
For i = StartI To EindI
Set RangeHI = Worksheets("onderhoud").Range("H" & i)
If RangeHI.Value <> "" Then
Call ohoudtoev(i)
End If
Next i
j = j + 1
Loop Until j = lbox1.ListCount - 1
'alle rijen automatisch resizen
Worksheets("hoofd").Rows.AutoFit
Worksheets("hoofd").Range("A1").Select
finish = Timer
totaltime = finish - start
MsgBox (totaltime)
End Sub
Private Sub ohoudtoev(ByVal rij As Long)
Dim i As Long
Dim RangeAI As Range
Dim RangeHI As Range
Dim RangeBI As Range
Set RangeHI = Worksheets("onderhoud").Range("A" & rij)
Set RangeBI = Worksheets("onderhoud").Range("B" & rij)
'eerstvolgende lege cel zoeken op de eerste sheet
With Worksheets("hoofd")
i = 6
Do
i = i + 1
Loop Until .Range("A" & i) = ""
Set RangeAI = .Range("A" & i)
End With
'wegschrijven tekst
RangeHI.Copy
RangeAI.Select
ActiveSheet.Paste
End Sub
But later on it will import more data and it is going to take longer, and what loop is faster the
i = a
do
i = i+1
loop until i = b
or the
for i is a to b
next i
TIA
frank