VB codes te langzaam?

[milaae]

Beste gene die mij wil helpen,

Ik heb een vraag betreffende het voorraadprogramma wat ik met behulp van VB heb geschreven.
Het bestand is nu bijna 5MB groot. Er staat nog niks van informatie in maar hij opent nu al te langzaam.
Zodra deze dan is geopend en ik wil voorraad bewerken(aan de hand van een formulier) moet het ook te lang nadenken.

Ik zou heel graag willen weten hoe ik dit sneller kan krijgen. Ik ben nog wel een beginner met VB, alhoewel ik wel al een heel programma heb geschreven denk ik dat de opbouw van de codes niet helemaal klopt, maar het werkt wel..

Info:
Form 1 laat de info van het product zien, of het in voorraad is, aantal, specs etc
(zie foto form1)
Zodra je dan op +/- voorraad klikt krijg je:
Form 2, hierop kan je aangeven hoeveel er precies in of uit gaat.
9Zie foto form2)

De codes die ik hiervoor heb gebruikt is:

Form 1 codes:

Private Sub CommandButton2_Click()

Worksheets("berekenen").Range("A3").Value = TextBox1.Value

TextBox2.Value = Worksheets("berekenen").Range("D9").Value
TextBox3.Value = Worksheets("berekenen").Range("D10").Value
TextBox4.Value = Worksheets("berekenen").Range("D11").Value
TextBox5.Value = Worksheets("berekenen").Range("D12").Value
TextBox6.Value = Worksheets("berekenen").Range("D14").Value
TextBox7.Value = Worksheets("berekenen").Range("D15").Value
TextBox8.Value = Worksheets("berekenen").Range("D17").Value
TextBox9.Value = Worksheets("berekenen").Range("D16").Value

Worksheets("berekenen").Range("E14") = TextBox6.Value
Worksheets("berekenen").Range("E16") = TextBox9.Value
    
End Sub


Private Sub CommandButton3_Click()
UserForm1.Hide

End Sub

Private Sub CommandButton4_Click()
UserForm2.Show
Unload Me
End Sub

Form2 codes:

Private Sub CommandButton1_Click()

On Error GoTo MyERROR

If Worksheets("berekenen").Range("D13") = "Nee" Then
Worksheets("berekenen").Range("E14").Value = TextBox1.Value
Worksheets("berekenen").Range("F15").Value = TextBox2.Value
Worksheets("berekenen").Range("F8,F9,F10,F11,F12,F14,F15,F16").Copy
Range("A" & Range("A65536").Offset.End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True

ElseIf Worksheets("berekenen").Range("D13") = "Ja" Then
Sheets(1).Columns(1).Find(Range("M1"), , xlValues, xlWhole).EntireRow.Delete
Worksheets("berekenen").Range("N14").Value = TextBox1.Value
Worksheets("berekenen").Range("O15").Value = TextBox2.Value
Worksheets("berekenen").Range("O8,O9,O10,O11,O12,O14,O15,O16,O17").Copy
Range("A" & Range("A65536").Offset.End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If

Unload Me
Worksheets("berekenen").Range("E14").Value = "0"
Worksheets("berekenen").Range("E16").Value = "0"

Exit Sub



MyERROR:
Msgbox "Code geeft error"




End Sub


Private Sub CommandButton2_Click()

On Error GoTo MyERROR

Worksheets("berekenen").Range("H16").Value = Worksheets("berekenen").Range("D16").Value

If Worksheets("berekenen").Range("D13") = "Nee" Then
Msgbox "Geen voorraad aanwezig"

ElseIf Worksheets("berekenen").Range("D13") = "Ja" Then
Sheets(1).Columns(1).Find(Range("M1"), , xlValues, xlWhole).EntireRow.Delete
Worksheets("berekenen").Range("H14").Value = TextBox1.Value
Worksheets("berekenen").Range("I8,I9,I10,I11,I12,I14,I15,I16,I17").Copy
Range("A" & Range("A65536").Offset.End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If

Unload Me
Worksheets("berekenen").Range("E14").Value = "0"
Worksheets("berekenen").Range("E16").Value = "0"

Exit Sub

MyERROR:
Msgbox "Code geeft error"

End Sub

Private Sub CommandButton3_Click()
On Error GoTo MyERROR

If Worksheets("berekenen").Range("D32") = "Nee" Then
Worksheets("berekenen").Range("E16").Value = TextBox1.Value
Worksheets("berekenen").Range("G8,G9,G10,G11,G12,G14,G15,G16,G17").Copy
Range("A" & Range("A65536").Offset.End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True

ElseIf Worksheets("berekenen").Range("D32") = "Ja" Then
Sheets(1).Columns(1).Find(Range("M1"), , xlValues, xlWhole).EntireRow.Delete
Worksheets("berekenen").Range("J16").Value = TextBox1.Value
Worksheets("berekenen").Range("K8,K9,K10,K11,K12,K14,K15,K16,K17").Copy
Range("A" & Range("A65536").Offset.End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If

Unload Me
Worksheets("berekenen").Range("E14").Value = "0"
Worksheets("berekenen").Range("E16").Value = "0"

Exit Sub



MyERROR:
Msgbox "Code geeft error"





End Sub

Private Sub CommandButton4_Click()

On Error GoTo MyERROR

Sheets(1).Columns(1).Find(Range("M1"), , xlValues, xlWhole).EntireRow.Delete
Worksheets("berekenen").Range("F31").Value = TextBox1.Value
Worksheets("berekenen").Range("G23,G24,G25,G26,G27,G29,G30,G31,G32").Copy
Range("A" & Range("A65536").Offset.End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True


Unload Me
Worksheets("berekenen").Range("E14").Value = "0"
Worksheets("berekenen").Range("E16").Value = "0"

Exit Sub



MyERROR:
Msgbox "Code geeft error"



End Sub

Kan iemand mij helpen? Ik hoop het! En alvast ontzettend bedankt!

groetjes
een beginnend VBerin

 

[leofact]

Op zich kan de code een stuk korter.
Om daar een voorbeeld van te geven

Worksheets("berekenen").Range("H16").Value = Worksheets("berekenen").Range("D16").Value

is hetzelfde als

sheet1.[h16]=sheet1.[d16]

En dat kan ook weer met with

With sheet1
      .[h12]= .[16]
End With

Zie daarvoor ook de help functie

Van deze acties zal de code achter niet merkbaar veel sneller gaan lopen.
Wat mogelijk wel helpt wanneer je de screenupdating en events uitzet aan het begin van de routines.

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Aan het eind van de procedure zet je deze dan weer op true en calculation op xlCalculationAutomatic

Hopelijk loopt e.e.a nu sneller.
5 mb blijft een flinke hap (tenminste als er via het netwerk geopend wordt)
Een keer opslaan als maakt het bestand soms kleiner.
Ook afbeeldingen kunnen vaak gecomprimeerd.
Veel gebruik van kleuren in de opmaak maakt het bestand ook groter.
Vooral als er sprake is van eigen gemaakte kleuren en voorwaardelijke opmaak.
Excel 2007 en 2010 slaan bestanden trouwens veel efficiënter op.

Hopelijk kun je iets met deze reactie.

Mvg Leo

 

[Warme bakkertje]

Hoe kom je überhaupt aan 5 Mb zonder 1 greintje data ?
Het veelvuldig gebruik van matrixformules kan ook een nefaste invloed hebben op de snelheid van je bestand.

 

[milaae]

Als eerste dank je wel voor jullie reacties!
Ik heb nog eens mijn hele blad/codes goed doorgekeken en heb de complexiteit van formules enigzins aangepast.
Ik denk dat ik er uit ben wat in eerste instantie zorgt voor de grootte van het bestand waardoor het zo langzaam wordt; de voorwaardelijke opmaak.
Deze code heb ik in het "overzichtvoorraadblad"zitten. Je krijgt dan eerst de hele berekening van voorraad af, bij etc
(de codes die ik in mijn eerste bericht heb geplaatst

Private Sub Worksheet_Change(ByVal Target As Range)

    Set MyPlage = Range("I2:I23000")
    
    For Each Cell In MyPlage
    
        Select Case Cell.Value
        
         Case Is = "ja"
            Cell.EntireRow.Interior.ColorIndex = 27
        
        Case Else
            Cell.EntireRow.Interior.ColorIndex = xlNone

End Select

Next

End Sub

Zodra er een artikel in bestelling is wordt dit aangegeven in een verborgen kolom met ja en hierdoor wordt de hele regel geel gemaakt zodat dit opvalt. Is er een manier om voorwaardelijkle opmaak toe te passen zonder dat het zo langzaam wordt?

Ik wil jullie nogmaals bedanken voor de hulp,

Veel groetjes,

 

[Warme bakkertje]

Als ik het goed begrijp vul je ergens in een regel iets in zodat in de verborgen kolom "Ja" komt te staan en aan de hand hiervan kleurt de regel geel. De fout die je maakt is dat je bij elke wijziging het volledige bereik doorloopt om naar "Ja" te zoeken.
Herschrijf je macro zo dat hij enkel op dezelfde regel naar de controlewaarde gaat zoeken.Ik zal het proberen te verduidelijken met een stukje code, want zonder voorbeeld is het nogal moeilijk een gericht antwoord te geven.
Stel dat een wijziging in kolom A ervoor zorgt dat de waarde in kolom I wijzigt naar "Ja"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Target.EntireRow.Interior.ColorIndex = IIf(Target.Offset(, 8) = "Ja", 27, xlNone)
    End If
End Sub

Op deze manier wordt er enkel naar 1 regel gekeken en wordt niet telkens je volledige bereik doorlopen

 

[milaae]

dank je voor je reactie!! ik begrijp helemaal wat je bedoelt, maar het lukt me niet om de code erin te krijgen.

kan het liggen aan het volgende:
de artikels die veranderen qua voorraad of in bestelling worden eerst met vert zoeken gevonden, vervolgens wordt die regel verwijdert en de nieuwe gegevens worden dan altijd onderaan de lijst opnieuw neergezet.

Kan je in die code ook verwijzen naar de laatste rij van het blad? want dit is zoiezo altijd de nieuwe rij die aangepast moet worden? ik heb geprobeerd dat te doen, maar hij kleurt de rij nog niet..
de code heb ik alsvolgt gemaakt:

Private Sub Worksheet_Change(ByVal Target As Range)

       If Target.Column = Range("A1").End(xlDown).Row Then
        Target.EntireRow.Interior.ColorIndex = IIf(Target.Offset(, 8) = "ja", 27, xlNone)
    End If
End Sub

Echt onwijs fijn dat je hiernaar wil kijken! Ik denk dat ik er echt bijna ben, maar toch nog een klein dingetje niet zie :shocked:

 

[Warme bakkertje]

1. Plaats de code in het blad waar de wijziging plaatsvind.
2.Laat Target.Column op 1 staan want het is daar dat de wijziging plaatsvind.
3.Target.EntireRow is steeds de huidige rij dus is er geen extra verwijzing nodig ([A1].End(xldown)
maw laat de macro zoals hij is maar let vooral op punt 1

 

[milaae]

Hallo Rudi, dank je wel wederom voor je reactie.

Ik heb alleen al de code precies geplaatst waar het hoort en verder niks veranderd maar hij doet niks en hij geeft een foutmelding:
Door de toepassing of het object gedefinieerde fout . code 1004

Wat ik net ook heb gezien is dat mijn betsand nu bijna 10 MB is, verdubbeld dus?!

Ik zou het bestand heel graag willen posten maar daar is het dus te groot voor, ook na inpakken..

 

[Warme bakkertje]

Stuur mij anders een PB zodat ik kan replyen voor mijn e-mailadres