Atwist
Terugkerende gebruiker
- Lid geworden
- 24 jan 2006
- Berichten
- 1.076
- Besturingssysteem
- Wndows 11
- Office versie
- 2016
Hallo
Ik ben op zoek naar de veroorzaker van de fout in onderstande code de fout zit in het rode deel fout melding is " script valt buiten het bereik".
Maar ik heb geen idee wat er percies gebeurt in deze code wat de fout melding betreft, de rest snap ik redelijk.
Ik hop dus dat er iemand is die mij over het betreffende deel iets kan vertelen.
Ik ben op zoek naar de veroorzaker van de fout in onderstande code de fout zit in het rode deel fout melding is " script valt buiten het bereik".
Maar ik heb geen idee wat er percies gebeurt in deze code wat de fout melding betreft, de rest snap ik redelijk.
Code:
Private Sub UserForm_Initialize()
Dim sq As Variant, i As Integer, r As Integer, k As Integer, c As Range, sFilter As String, lRij As Long, lijst As Variant
With Worksheets("Archief") 'je werkblad
Set c = .Range("A1:A10000") 'vrij grote range nemen in de 1e kolom
lRij = Application.Evaluate("=MAX(IF(" & c.Address & "<>"""",ROW(" & c.Address & "),""""))") 'rijnummer van laatste niet-lege cel in dat bereik ook al is bereik gefilterd
Set Bereik = .Range("A1:A" & lRij).Resize(, AantalKolommen) 'je gegevens (tot laatste niet-lege A-cel & 4 kolommen breed
'om snelheid te winnen, wil je niet telkens de filter aanpassen, dat wordt gecheckt met het vlaggetje bOK
'is het vlaggetje nog niet opgezet, dan wordt dit stukje doorlopen
If Not bOK Then
.AutoFilterMode = False 'vorige filter uitzetten
Bereik.AutoFilter 'nieuw filter installeren
End If
'opnieuw om snelheid te winnen, de 4 kolommen controleren of en op wat er gefilterd wordt en die gegevens naar de macro "AanpassenAutofilter" sturen met de juiste parameters
For i = 1 To 6
If Me("ComboBox" & i).ListIndex <> -1 Then 'iets gekozen in die combobox ?
sFilter = Me("ComboBox" & i).Value 'gebruik de combobox1 om te filteren
Me("TextBox" & i).Value = "" 'om verwarring te voorkomen wis je de textbox
Else
sFilter = Me("TextBox" & i).Value & "*" 'gebruik de textboxes om te filteren
End If
AanpassenAutofilter i, sFilter
Next
'ook om snelheid te winnen voor de comboxes, die wil je ook niet telkens updaten, enkel als het nodig is
If Not bCombos Then
With Sheets("Blad3") 'dit is het hulpblad, best voor niets anders gebruiken !!!!!!
.Visible = True 'xlVeryHidden 'alleen zichtbaar voor VBA
.UsedRange.Clear 'leegmaken
Bereik.Copy .Range("a1") 'je gegevens naar hier kopieren
For i = 1 To 6 '1 voor 1 de 1e 6 kolommen langslopen
.Columns("AA").Clear 'hulpkolom wissen
.Columns(i).AdvancedFilter xlFilterCopy, , .Range("AA1"), True 'unieke waarden naar hulpkolom kopieren
.Columns("AA").Sort key1:=.Range("AA2"), Header:=xlYes 'oplopend sorteren
.Range("AA1").Value = "(alles)" 'kop weghalen
lijst = WorksheetFunction.Transpose(.Range("AA1:AA" & .Range("AA" & Rows.Count).End(xlUp).Row)) 'waarden meegeven naar array
Me("ComboBox" & i).List = lijst
Next
End With
End If
'laatste stukje : zichtbare gegevens inlezen en naar listbox sturen
If Not bOK Or Not bCombos Then
i = WorksheetFunction.Subtotal(103, Bereik.Columns(1)) - 1 'aantal zichtbare rijen in die gegevens (let wel : kolom 1 bevat geen lege cellen, tel ook koprij niet mee)
If i <= 0 Then
ListBox1.Clear 'alles weggefilterd = geen gegevens
Else
ReDim sq(0 To i - 1, 0 To Bereik.Columns.Count - 1) 'array dimensioneren
For Each c In Bereik.Columns(1).SpecialCells(xlVisible) 'alle zichtbare cellen in 1e kolom bereik aflopen
If c.Row <> Bereik.Row Then
For k = 0 To UBound(sq, 2) 'alle kolommen aflopen
[COLOR="red"] sq(r, k) = c.Offset(, k).Value[/COLOR]
Next
sq(r, 6) = c.Row 'gemakshalve ook rijnummer meegeven
r = r + 1
End If
Next
ListBox1.List = sq 'listbox vullen
End If
bOK = True
End If
End With
bOK = True
bCombos = True 'filter en comboboxes zijn netjes ingelezen, zolang je niets aan de gegevens verandert, moeten die niet geupdatet wordenIk hop dus dat er iemand is die mij over het betreffende deel iets kan vertelen.
