Sneller vullen listbox

[Jelle2010]

Beste experts,

Ik heb de volgende code die een listbox vult met gegevens. Deze formule doorloopt momenteel ongeveer 6.000 regels. Dit duurt redelijk lang voordat de listbox is gevuld met gegevens. Weten jullie misschien een mogelijkheid om dit sneller te laten verlopen?
Alvast super bedankt!

Sub fillklanten()
    Dim i As Integer
        i = 2
    lstKlant.Clear
    txtKlant.Value = ""
    txtGemeente.Value = ""
    txtAdres.Value = ""
    With Klanten
    Do Until .Cells(i, 1).Value = ""
        lstKlant.AddItem .Cells(i, 2).Value
        lstKlant.List(lstKlant.ListCount - 1, 1) = .Cells(i, 3).Value
        lstKlant.List(lstKlant.ListCount - 1, 2) = .Cells(i, 4).Value
        lstKlant.List(lstKlant.ListCount - 1, 3) = .Cells(i, 5).Value
        lstKlant.List(lstKlant.ListCount - 1, 4) = .Cells(i, 6).Value
        lstKlant.List(lstKlant.ListCount - 1, 5) = .Cells(i, 11).Value & " " & .Cells(i, 12).Value & " " & .Cells(i, 13).Value
        lstKlant.List(lstKlant.ListCount - 1, 6) = .Cells(i, 14).Value
        lstKlant.List(lstKlant.ListCount - 1, 7) = .Cells(i, 20).Value
        lstKlant.List(lstKlant.ListCount - 1, 8) = .Cells(i, 17).Value
        If .Cells(i, 15).Value <> "" Then
            lstKlant.List(lstKlant.ListCount - 1, 9) = .Cells(i, 15).Value
        Else
            lstKlant.List(lstKlant.ListCount - 1, 9) = .Cells(i, 16).Value
        End If
        i = i + 1
    Loop
    End With
End Sub

 

[OctaFish]

Je kunt hier misschien wel wat mee...

'----------------------------------------------------------------------------------------------------------------
'Reading the contents of an Excel Range
'----------------------------------------------------------------------------------------------------------------
'The following code can be used to quickly extract the values of an Excel Range into an array.
'Purpose     :  Reads the values of a range into an array (much quicker than looping through a range)
'Inputs      :  rngInput                The range to extract the values from.
'               avValues                See outputs.
'Outputs     :  Returns the True on success.
'               avValues                An 2d array containing the values in the range.
'Example     :  Call RangeToArray(Worksheets(1).Range("A1:K1000"), avValues)
Function RangeToArray(rngInput As Object, avValues As Variant) As Boolean
    On Error GoTo ErrFailed
    avValues = Empty
    avValues = rngInput.Value
    RangeToArray = True
    
    Exit Function
ErrFailed:
    'Failed
    Debug.Print "Error in RangeToArray: " & Err.Description
    Debug.Assert False
    RangeToArray = False
    On Error GoTo 0
End Function

'----------------------------------------------------------------------------------------------------------------
Sub test()
Dim i As Integer, iCol As Integer, y As Integer
Dim TestRange, tmp
 
Call RangeToArray(Worksheets(1).Range("A1:D7"), TestRange)
    
iCol = ArrayNumDimensions(TestRange, TestRange)
    For i = LBound(TestRange) To UBound(TestRange)
        For y = 1 To iCol
            tmp = tmp & " - " & TestRange(i, iCol)
        Next y
        tmp = tmp & vbCrLf
''        MsgBox TestRange(i, 1)
    Next i
End Sub

 

[Jelle2010]

Super bedankt voor je snelle reactie OctaFish. Ik kreeg wel een foutmelding bij "arraynumdims" met de melding dat ik een functievariabele niet had gedefinieerd. Ik heb het nu opgelost op de volgende manier:

Sub Fillklanten()
    Dim lbtarget As MSForms.ListBox
    Dim rngSource As Range
    Dim lastrow As Integer
    
    Klanten.Visible = xlSheetVisible
        
    Worksheets("klantenbestand").Activate
    lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row
    
    Klanten.Visible = xlSheetHidden
    
    'Set reference to the range of data to be filled
    Set rngSource = Worksheets("klantenbestand").Range("B2:K" & lastrow)
    
    'Fill the listbox
    Set lbtarget = Me.lstKlant
    With lbtarget
        'Determine number of columns
        .ColumnCount = 10
        'Set column widths
        .ColumnWidths = "50;210;100;100;0;0;0;0;0;0"
        'Insert the range of data supplied
        .List = rngSource.Cells.Value
    End With
        
End Sub