• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Traag Excelbestand door VBA scripts

Status
Niet open voor verdere reacties.
S

Siafu

Gebruiker
Lid geworden
13 mrt 2018
Berichten
14
Hallo,
Ik heb een bestand met een VBA script (per tabblad) het bestand heeft echter 45 tabbladen en daarmee dus een heel groot aantal VBA scripts
Het script is er om automatisch regels te verbergen aan de hand van bepaalde cellen.
Het probleem wat hiermee ontstaat is dat het bestand ontzettend traag wordt.
Ik vroeg mij af wat de mogelijkheden hiertegen zijn:
- scripts samenvoegen tot 1 (groot) script op een blad die de hele werkmap beslaat?
- scripts aanpassen?
- andere manieren om regels automatisch zichtbaar en onzichtbaar te maken aan de hand van bepaalde cellen op een standaard tabblad (invoerblad)?

Het script ziet er als volgt uit:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For Each c In Range("c11:c693")
If c.Value = 0 Then
Rows(c.Row).Hidden = True
Else
Rows(c.Row).Hidden = False
End If
Next
End Sub


Dit script wordt toegepast op individuele tabs, waarbij het nodig is dat er regels verborgen worden.
Deze regels worden allemaal zichtbaar op het moment dat er op een Standaard tab iets ingevuld wordt.
Het standaardblad is een "template" voor de andere tabs..

Ik snap dat het handig is om er een voorbeeld bij te doen maar zou eerst wat reacties krijgen als dit mogelijk is.
Indien nodig upload ik het bestand wel (heb geen voorbeeld), al wacht ik hier liever mee.

Mvg,
Frank
 
Verwijder "Selection" uit SelectionChange zodat het event alleen iets doet wanneer je een cel wijzigt. Ervan uitgaande dat de cellen in kwestie handmatig worden aangepast en niet formules bevatten natuurlijk.
 
Wat jkpieterse zei en meer:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    For Each c In Range("C11:C693")
        Rows(c.Row).Hidden = IIf(c.Value = 0, True, False)
    Next
    Application.ScreenUpdating = True
End Sub
 
Bedankt voor de snelle reactie!
Het script werkt niet helemaal meer naar behoren na het verwijderen van Selection.

Ik heb het bestand een klein beetje aangepast zodat ik hem hier op kan zetten.
De bedoeling is dat alle (het meeste) info vanuit het blad Standaard, wordt doorgevoerd naar alle andere bladen.
Het tabblad Standaard moet dan ook niet aangepast worden (alle regels zichtbaar)
dit geldt ook voor het Waarden blad. Hier hoeft ook niets te veranderen.

De overige bladen moeten dus reageren op de invoer (tekst) op het blad Standaard in de C kolom.
Lege cellen zorgen dat de regels verborgen worden en een gevulde cel maakt de regel zichtbaar (na een klik in het betreffende tabblad).

Ik heb een testbestand geüpload. Misschien dat dit meer inzicht geeft.

Mvg,
Frank


EDIT*: Volgens mij werkt het! hij past het scherm pas aan nadat ik een cel aangeklikt heb en niet meer na elke klik zoals eerst.

EDIT2*: Wat ik mij af vroeg (niet geheel thuis in VBA) is het normaal dat de UNDO functie uitgezet wordt? Is dit te omzeilen?
 

Bijlagen

  • Testbestand scriptprobleem.xlsm
    1,5 MB · Weergaven: 45
Laatst bewerkt:
In de module van ThisWorkbook. En alle andere code weghalen.

Ipv SheetSelectionChange kan je ook Workbook_SheetChange gebruiken.
Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range
  Rows("11:693").Hidden = False
  For Each cl In Range("c11:c693")
    If cl.Value = 0 Then
      If r Is Nothing Then Set r = cl Else Set r = Union(r, cl)
    End If
  Next cl
  If Not r Is Nothing Then r.EntireRow.Hidden = True
End Sub
 
Volgens mij kan je alle code weggooien en vervangen door dit stukje, ALLEEN IN Blad 1 (Standaard1):
Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oSh As Worksheet
    Dim bVisible As Boolean
    If Intersect(Target, Me.Range("C11:C293")) Is Nothing Then Exit Sub
    bVisible = Len(Target.Value) > 0
    For Each oSh In Worksheets
        If oSh.Name <> Me.Name Then
            oSh.Range(Target.Address).EntireRow.Hidden = Not bVisible
        End If
    Next
End Sub
 
Zorgt dat script er dan voor dat Standaard1 niet wordt aangepast?
Op dat tabblad moeten alle regels zichtbaar blijven (dit geldt ook voor Waardenblad)

Mvg,
Frank
 
Zo beter?
Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Waardenblad" Or Sh.Name = "Standaard1" Then Exit Sub
Dim r As Range
  Rows("11:693").Hidden = False
  For Each cl In Range("c11:c693")
    If cl.Value = 0 Then
      If r Is Nothing Then Set r = cl Else Set r = Union(r, cl)
    End If
  Next cl
  If Not r Is Nothing Then r.EntireRow.Hidden = True
End Sub
 
VenA: SheetSelectionCHange is overkill, het hoeft alleen iets te doen bij wijziging aan werkblad Standaard1. Vandaar dat mijn code alleen achter dat werkblad staat.
Siafu:

Pas deze regel:
Code: 
If oSh.Name <> Me.Name Then
aan naar:
Code: 
If oSh.Name <> Me.Name And oSh.Name <> "Waardenblad" Then
 
Op dit moment gebruik ik het volgende script:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
For Each c In Range("C11:C693")
Rows(c.Row).Hidden = IIf(c.Value = 0, True, False)
Next
Application.ScreenUpdating = True
End Sub


Deze werkt naar behoren!
Ik heb echter nog een ander Excel project, waar ik dit ook in wil toepassen
als ik de range aanpas krijg ik echter een foutmelding:

Fout 1004 tijdens uitvoering:
Methode Range van object_Worksheet is mislukt

Het gaat nu om Kolom B en de range is:
b11:b80;b84:b153;b157:b226;b230:b299;b303:b372

Dit zou resulteren in:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
For Each b In Range("b11:b80;b84:b153;b157:b226;b230:b299;b303:b372")
Rows(b.Row).Hidden = IIf(b.Value = 0, True, False)
Next
Application.ScreenUpdating = True
End Sub


Waar ga ik fout?
Kan het zo zijn dat er factoren als filteren aanstaan en er invloed op hebben?
Bij voorbaat dank!
 
wijzig de ; in
Code: 
For Each b In Range("b11:b80;b84:b153;b157:b226;b230:b299;b303:b372")
eens in ,
 
Wat zijn het soms ook simpele dingen :D
Hij doet het!

Bedankt
 
@jkpieterse, Ik ben het met je eens dat SheetSelectionCHange overkill is. Het alternatief had jij al benoemd en ik ook in #5. Om nu bij elke wijziging in blad Standaard1 alle sheets af te lopen is ook overkill.;) Mij lijkt Workbook_SheetActivate de beste optie. De TS heeft blijkbaar niets gedaan met onze suggesties. :shocked:
 
Ik wil zeker wel alles proberen wat jullie voorstellen hoor!
Het werkt voor nu precies zoals ik wil dus ben ik eigenlijk wel tevreden (heb er niet heel veel verstand van allemaal).
Zodra ik wat meer tijd heb zal ik er eens in duiken wat er nog meer mogelijk is!
Voor nu heel erg bedankt voor het meedenken

Mvg,
Frank
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan