Hallo lezer,
Onderstaande VBA code werkt wel maar het volgende is een probleem: de vba wordt uitgevoerd in een accessdatabase waarin iedereen tegelijkertijd kan werken. OPvallend is dat als ik deze lus s ochtends vroeg net na opstarten van mijn computer draai maximaal 2 minuten duurt. Verander ik wat in de vba of probeer ik het gewoon op de dag dan duurt dezelfde lus bijna een uur.
Wat kan ik doen om die lus altijd sneller te laten draaien? Vooral dit stukje
duurt erg lang. Maar ik kan niet echt ontdekken waarom? Iemand suggesties?
groet,
BB
Onderstaande VBA code werkt wel maar het volgende is een probleem: de vba wordt uitgevoerd in een accessdatabase waarin iedereen tegelijkertijd kan werken. OPvallend is dat als ik deze lus s ochtends vroeg net na opstarten van mijn computer draai maximaal 2 minuten duurt. Verander ik wat in de vba of probeer ik het gewoon op de dag dan duurt dezelfde lus bijna een uur.
Wat kan ik doen om die lus altijd sneller te laten draaien? Vooral dit stukje
Code:
Call Uitvoer1997BalansCO2(StudiegroepCIJFERU1997T, JaarU1997T, CIJFERU1997T, GemengdU1997T, _
Tekst5, Tekst9, Tekst13, Tekst17, Tekst36, Tekst21)duurt erg lang. Maar ik kan niet echt ontdekken waarom? Iemand suggesties?
groet,
BB
Code:
Private Sub CO2_Click()
Dim Dbase As DAO.Database
Dim strSQL4, strSQL3, strSQL1, strSQL2 As String
Dim rst1 As DAO.Recordset
Dim StudiegroepCIJFERU1997T, GemengdU1997T, JaarU1997T, CIJFERU1997T, C, PercVetU1997T, PercEiwitU1997T, KgAfgeleverdeMelkU1997T
Dim GVEGemiddeldAanwezig1, Tekst27, StartTijd, EindTijd, TotalTime, RuwvoerPmovU1997T, ProductieTotaalN, WeideFactor, TotaalKgDsPmovU1997T
Dim MijnVar, OpslagKuub, GVEGemiddeldAanwezig2, GVEGemiddeldAanwezig3, KmKleiZand, KmVeen
Dim HAGRASKlei, HAMAISKlei, HAGRASZand, HAMAISZand, HAGRASVeen, HAMAISVeen, HAGRAS, HAMAIS, HAAKKER
Dim CO2Methaan, CO2MethaanMelkKoe, CO2MethaanJngvgr1, CO2MethaanJngvkl1, CO2MethaanMestOpslag
Dim CO2Lachgas, CO2LachgasPens, CO2LachgasMestOpslag, CO2LachgasGrond, CO2LachgasKunstmest, CO2LachgasDrijfmest, CO2LachgasNBinding, CO2LachgasBeweiding, CO2LachgasNitraatGraskuil, CO2LachgasEnergie, CO2LachgasUitspoeling, CO2LachgasVervluchtiging, CO2LachgasKunstmestAankoop, CO2LachgasRuwvoerBijprodAankoop, CO2LachgasKrachtvoerAankoop
'Tekst17 = kunstmestN
'Tekst 21 = aanvoerMestN
'Tekst 36 = afvoerMestN
Dim Tekst5, Tekst9, Tekst13, Tekst17, Tekst36, Tekst21
'Dim CO2Methaan, CO2MethaanMelkKoe, CO2MethaanJngvgr1, CO2MethaanJngvkl1, CO2MethaanMestOpslag
Dim Variabele1, Variabele2 As String
Dim Message, Title, Default
Dim MyValue As Integer
Message = "Voer jaartal in waarvan u records wil wijzigen" ' Stel vraag in.
Title = "Vullen UitvoerGegevensMestbeleid2" ' Stelt titel in.
Default = "2011" ' Stelt standaard in.
' Geeft dialoogvenster weer op positie 100, 100.
MyValue = InputBox(Message, Title, Default, 1000, 1000)
'SGC_F_Leden = Forms!Leden!StudiegroepCIJFER
StartTijd = Timer
'Octafish:
MijnVar = "0"
Variabele1 = 1
'Variabele2 = 0
'CIJFER1997 = 1
'strSQL1 = "Select * From UitvoerGegevensMestbeleid Where ([JAAR] = 2007 Or [JAAR] = 2008) AND [Gemengd] = '" & MijnVar & "' AND [VeestapelN] > 0 Order by [StudiegroepCIJFER]"
strSQL1 = "Select * From Uitvoer1997technisch Where [JAAR] = " & MyValue & " AND [CIJFER] = " & Variabele1 & " AND [Gemengd] = '" & MijnVar & "'Order by [JAAR] Desc"
'tmp = InputBox("", "", strSQL1)
'AND [CIJFER] = " & Variabele1 & " AND [Gemengd] = '" & MijnVar & "'
Set Dbase = CurrentDb
Set rst1 = Dbase.OpenRecordset(strSQL1)
If rst1.RecordCount <> 0 Then
rst1.MoveLast
rst1.MoveFirst
Do While Not rst1.EOF
StudiegroepCIJFERU1997T = rst1![STUDIEGROEP].Value
'If Left(StudiegroepCIJFER1, 6) <> Left(SGC_F_Leden, 6) Then GoTo RST1MoveNext:
JaarU1997T = rst1![Jaar].Value
CIJFERU1997T = rst1![CIJFER].Value
GemengdU1997T = rst1![Gemengd].Value
RuwvoerPmovU1997T = rst1![RuwvoerPmov].Value
TotaalKgDsPmovU1997T = rst1![TotaalKgDsPmov].Value
PercVetU1997T = rst1![VET%].Value
PercEiwitU1997T = rst1![EIWIT%].Value
KgAfgeleverdeMelkU1997T = rst1![KgAfgeleverdeMelk].Value
'hier worden waarden in de andere tabellen opgehaald!
Call InvoerGegevensMestbeleidCO2(StudiegroepCIJFERU1997T, JaarU1997T, CIJFERU1997T, GemengdU1997T, _
GVEGemiddeldAanwezig1, Tekst27, GVEGemiddeldAanwezig2, GVEGemiddeldAanwezig3, _
HAGRAS, HAMAIS, HAAKKER, HAGRASKlei, HAMAISKlei, HAGRASZand, HAMAISZand, HAGRASVeen, HAMAISVeen)
Call UitvoerGegevensMestbeleidCO2(StudiegroepCIJFERU1997T, JaarU1997T, CIJFERU1997T, GemengdU1997T, _
OpslagKuub, ProductieTotaalN, WeideFactor)
Call Uitvoer1997BalansCO2(StudiegroepCIJFERU1997T, JaarU1997T, CIJFERU1997T, GemengdU1997T, _
Tekst5, Tekst9, Tekst13, Tekst17, Tekst36, Tekst21)
'Hier gaan we de vakjes vullen in de huidige record
rst1.Edit
rst1!MethaanMelkKoe = Round((50 + 0.01 * (Tekst27 / GVEGemiddeldAanwezig1)) * GVEGemiddeldAanwezig1, 1)
rst1![MethaanJngv>1].Value = Round(GVEGemiddeldAanwezig2 * 31, 1)
rst1![MethaanJngv<1].Value = Round(GVEGemiddeldAanwezig3 * 25, 1)
rst1!MethaanMestOpslag = Round(OpslagKuub * 1.3, 0)
rst1!LachgasPens = Round(0.00005 * (Tekst5 + Tekst9 + Tekst13 + (RuwvoerPmovU1997T * (HAGRAS + HAMAIS + HAAKKER))), 1)
Select Case WeideFactor
Case 1
WeideFactor = 0
Case 0.8
WeideFactor = (6 * 30 * 12) / (365 * 24)
Case Else
WeideFactor = (6 * 30 * 24) / (365 * 24)
End Select
rst1!LachgasMestOpslag = Round(0.00005 * (ProductieTotaalN * (1 - (WeideFactor))), 1)
rst1!LachgasGrond = Round((0.9 * (HAGRASKlei + HAMAISKlei + HAGRASZand + HAMAISZand + HAAKKER)) + (5.3 * (HAGRASVeen + HAMAISVeen)), 1)
KmKleiZand = (HAGRASKlei + HAMAISKlei + HAGRASZand + HAMAISZand + HAAKKER) / (HAGRAS + HAMAIS + HAAKKER)
KmVeen = 1 - KmKleiZand
rst1!LachgasKunstmest = Round((0.01 * (Tekst17 * KmKleiZand) * 0.9) + (0.03 * (Tekst17 * KmVeen) * 0.9), 1)
rst1!LachgasDrijfmest = Round((0.005 * ((ProductieTotaalN - Tekst36 + Tekst21 - (ProductieTotaalN * WeideFactor)) * KmKleiZand) * 0.8) + (0.01 * ((ProductieTotaalN - Tekst36 + Tekst21 - (ProductieTotaalN * WeideFactor)) * KmVeen) * 0.8), 1)
rst1!LachgasNBinding = 0
rst1!LachgasBeweiding = Round(((0.025 * (ProductieTotaalN * WeideFactor) * KmKleiZand) + (0.06 * (ProductieTotaalN * WeideFactor) * KmVeen)) * 0.8, 1)
rst1!LachgasNitraatGraskuil = Round(0.015 * (3.5 * (((TotaalKgDsPmovU1997T * (HAGRAS + HAMAIS)) - (HAMAIS * 15000)) / 1000)), 1)
'dit is een vaste waarde, moet in de loop van de tijd aangepast gaan worden! Zie excel emmissiekrinloopbestand
rst1!LachgasEnergie = 0.81
rst1!LachgasUitspoeling = Round(0.025 * (ProductieTotaalN + Tekst21 - Tekst36 + Tekst17) * 0.3, 1)
rst1!LachgasVervluchtiging = Round(0.005 * ((Tekst17 * 0.1) + (ProductieTotaalN) * 0.2), 1)
rst1!LachgasKunstmestAankoop = Round(0.005 * Tekst17, 1)
rst1!LachgasRuwvoerBijprodAankoop = Round(0.02 * (Tekst9 + Tekst13), 1)
rst1!LachgasKrachtvoerAankoop = Round(0.01 * Tekst5, 1)
CO2MethaanMelkKoe = ((50 + 0.01 * (Tekst27 / GVEGemiddeldAanwezig1)) * GVEGemiddeldAanwezig1) * 21
CO2MethaanJngvgr1 = (GVEGemiddeldAanwezig2 * 31) * 21
CO2MethaanJngvkl1 = (GVEGemiddeldAanwezig3 * 31) * 21
CO2MethaanMestOpslag = (OpslagKuub * 1.3) * 21
CO2Methaan = CO2MethaanMelkKoe + CO2MethaanJngvgr1 + CO2MethaanJngvkl1 + CO2MethaanMestOpslag
CO2LachgasPens = (0.00005 * (Tekst5 + Tekst9 + Tekst13 + (RuwvoerPmovU1997T * (HAGRAS + HAMAIS + HAAKKER)))) * 310
CO2LachgasMestOpslag = (0.00005 * (ProductieTotaalN * (1 - (WeideFactor)))) * 310
CO2LachgasGrond = ((0.9 * (HAGRASKlei + HAMAISKlei + HAGRASZand + HAMAISZand + HAAKKER)) + (5.3 * (HAGRASVeen + HAMAISVeen))) * 310
CO2LachgasKunstmest = ((0.01 * (Tekst17 * KmKleiZand) * 0.9) + (0.03 * (Tekst17 * KmVeen) * 0.9)) * 310
CO2LachgasDrijfmest = ((0.005 * ((ProductieTotaalN - Tekst36 + Tekst21 - (ProductieTotaalN * WeideFactor)) * KmKleiZand) * 0.8) + (0.01 * ((ProductieTotaalN - Tekst36 + Tekst21 - (ProductieTotaalN * WeideFactor)) * KmVeen) * 0.8)) * 310
CO2LachgasNBinding = 0
CO2LachgasBeweiding = (((0.025 * (ProductieTotaalN * WeideFactor) * KmKleiZand) + (0.06 * (ProductieTotaalN * WeideFactor) * KmVeen)) * 0.8) * 310
CO2LachgasNitraatGraskuil = (0.015 * (3.5 * (((TotaalKgDsPmovU1997T * (HAGRAS + HAMAIS)) - (HAMAIS * 15000)) / 1000))) * 310
'dit is een vaste waarde, moet in de loop van de tijd aangepast gaan worden! Zie excel emmissiekrinloopbestand
CO2LachgasEnergie = 0.81 * 310
CO2LachgasUitspoeling = (0.025 * (ProductieTotaalN + Tekst21 - Tekst36 + Tekst17) * 0.3) * 310
CO2LachgasVervluchtiging = (0.005 * ((Tekst17 * 0.1) + (ProductieTotaalN) * 0.2)) * 310
CO2LachgasKunstmestAankoop = (0.005 * Tekst17) * 310
CO2LachgasRuwvoerBijprodAankoop = (0.02 * (Tekst9 + Tekst13)) * 310
CO2LachgasKrachtvoerAankoop = (0.01 * Tekst5) * 310
CO2Lachgas = CO2LachgasPens + CO2LachgasMestOpslag + CO2LachgasGrond + CO2LachgasKunstmest + CO2LachgasDrijfmest + CO2LachgasNBinding + _
CO2LachgasBeweiding + CO2LachgasNitraatGraskuil + CO2LachgasEnergie + CO2LachgasUitspoeling + CO2LachgasVervluchtiging + _
CO2LachgasKunstmestAankoop + CO2LachgasRuwvoerBijprodAankoop + CO2LachgasKrachtvoerAankoop
rst1!TotaalCO2 = Round(CO2Lachgas + CO2Methaan, 0)
'KgAfgeleverdeMelk: Round((0,337+(0,116*[T_Uitvoer1997TechnischVanaf2006]![VET%])+(0,06*[T_Uitvoer1997TechnischVanaf2006]![EIWIT%]))*[T_Uitvoer1997TechnischVanaf2006]![KgAfgeleverdeMelk];0)
rst1!CO2KgMM = Round((CO2Lachgas + CO2Methaan) / ((0.337 + (0.116 * PercVetU1997T) + (0.116 * PercEiwitU1997T)) * KgAfgeleverdeMelkU1997T), 2)
rst1.Update
RST1MoveNext:
rst1.MoveNext
Loop
Else
End If
rst1.Close
EindTijd = Timer
TotalTime = Round((EindTijd - StartTijd) / 60, 0)
MsgBox "Tabel UitvoerGegevensMestbeleid2 gevuld en duurde " & TotalTime & " minuten!"
End Sub
Private Sub InvoerGegevensMestbeleidCO2(ByRef StudiegroepCIJFERU1997T, ByRef JaarU1997T, ByRef CIJFERU1997T, ByRef GemengdU1997T, ByRef GVEGemiddeldAanwezig1, _
ByRef Tekst27, ByRef GVEGemiddeldAanwezig2, ByRef GVEGemiddeldAanwezig3, ByRef HAGRAS, ByRef HAMAIS, ByRef HAAKKER, ByRef HAGRASKlei, ByRef HAMAISKlei, ByRef HAGRASZand, ByRef HAMAISZand, _
ByRef HAGRASVeen, ByRef HAMAISVeen)
Dim DatBase As DAO.Database
Dim strSQL2 As String
Dim tmp1, Gemengd, Gemengd2
Set DatBase = CurrentDb
Gemengd = "0"
Gemengd2 = CStr(Gemengd)
'Stop
strSQL2 = "Select * From InvoerGegevensMestbeleid Where [StudiegroepCIJFER] = '" & StudiegroepCIJFERU1997T & "' And [CIJFER] = " & CIJFERU1997T & " AND [JAAR] = " & JaarU1997T & " AND [Gemengd] = '" & GemengdU1997T & "' Order by [JAAR] Desc"
With DatBase.OpenRecordset(strSQL2)
If .RecordCount > 0 Then
[GVEGemiddeldAanwezig1] = .Fields("GVEGemiddeldAanwezig1").Value
[GVEGemiddeldAanwezig2] = .Fields("GVEGemiddeldAanwezig2").Value
[GVEGemiddeldAanwezig3] = .Fields("GVEGemiddeldAanwezig3").Value
[Tekst27] = .Fields("27").Value
[HAGRAS] = .Fields("HAGRAS").Value
[HAMAIS] = .Fields("HAMAIS").Value
[HAAKKER] = .Fields("HAAKKER").Value
[HAGRASKlei] = .Fields("HAGRASKlei").Value
[HAMAISKlei] = .Fields("HAMAISKlei").Value
[HAGRASZand] = .Fields("HAGRASZand").Value
[HAMAISZand] = .Fields("HAMAISZand").Value
[HAGRASVeen] = .Fields("HAGRASVeen").Value
[HAMAISVeen] = .Fields("HAMAISVeen").Value
End If
.Close
End With
DatBase.Close
Set DatBase = Nothing
End Sub
Private Sub UitvoerGegevensMestbeleidCO2(ByRef StudiegroepCIJFERU1997T, ByRef JaarU1997T, ByRef CIJFERU1997T, ByRef GemengdU1997T, ByRef OpslagKuub, _
ByRef ProductieTotaalN, ByRef WeideFactor)
Dim DatBase As DAO.Database
Dim strSQL2 As String
Dim tmp1, Gemengd, Gemengd2
Set DatBase = CurrentDb
Gemengd = "0"
Gemengd2 = CStr(Gemengd)
'Stop
strSQL2 = "Select * From UitvoerGegevensMestbeleid Where [StudiegroepCIJFER] = '" & StudiegroepCIJFERU1997T & "' And [CIJFER] = " & CIJFERU1997T & " AND [JAAR] = " & JaarU1997T & " AND [Gemengd] = '" & GemengdU1997T & "' Order by [JAAR] Desc"
With DatBase.OpenRecordset(strSQL2)
If .RecordCount > 0 Then
[OpslagKuub] = .Fields("OpslagKuub").Value
[ProductieTotaalN] = .Fields("ProductieTotaalN").Value
[WeideFactor] = .Fields("WeideFactor").Value
End If
.Close
End With
DatBase.Close
Set DatBase = Nothing
End Sub
Private Sub Uitvoer1997BalansCO2(ByRef StudiegroepCIJFERU1997T, ByRef JaarU1997T, ByRef CIJFERU1997T, ByRef GemengdU1997T, ByRef Tekst5, _
ByRef Tekst9, ByRef Tekst13, ByRef Tekst17, ByRef Tekst36, ByRef Tekst21)
Dim DatBase As DAO.Database
Dim strSQL2 As String
Dim tmp1, Gemengd, Gemengd2
Set DatBase = CurrentDb
Gemengd = "0"
Gemengd2 = CStr(Gemengd)
'Stop
strSQL2 = "Select * From Uitvoer1997Balans Where [Studiegroep] = '" & StudiegroepCIJFERU1997T & "' And [CIJFER] = " & CIJFERU1997T & " AND [JAAR] = " & JaarU1997T & " AND [Gemengd] = '" & GemengdU1997T & "' Order by [JAAR] Desc"
With DatBase.OpenRecordset(strSQL2)
If .RecordCount > 0 Then
[Tekst5] = .Fields("5").Value
[Tekst9] = .Fields("9").Value
[Tekst13] = .Fields("13").Value
[Tekst17] = .Fields("17").Value
[Tekst36] = .Fields("36").Value
[Tekst21] = .Fields("21").Value
End If
.Close
End With
DatBase.Close
Set DatBase = Nothing
End Sub
