code voor filtreren van gegevens en aanpassen

[Eastw00d]

ik krijg het wel voor elkaar om mijn gegevens gte filtreren dmv vba. maar ik kan deze gegevens vervolgens niet bewerken op de orginele plaats. iemand een idee?

 

[AHulpje]

He wat raar, het lukt mij wel.

 

[edmoor]

Hier komt er helaas alleen maar Null uit.

 

[Eastw00d]

ik ben al verder, maar zit vast op een ander punt. De gefilterde waarde veranderd niet mee in mijn listbox

 

[AHulpje]

Probeer het zo eens:

 

[HSV]

Twee andere opties zonder extra blad.

 

[AHulpje]

Nog eentje:

 

[AHulpje]

Verkeerde versie gepost, hierbij de juiste.

 

[AHulpje]

Deze versie start met gevulde listbox en listbox wordt weer helemaal gevuld na Reset.

 

[Eastw00d]

dank jullie allemaal voor het meedenken

 

[HSV]

Nieuwe versies (Office 365), ander aanpak.
Zonder loop.

 

[AHulpje]

@HSV
Doet het ook prima met Office 2021!

 

[HSV]

Inderdaad, vergeet steeds dat de application.filter al vanaf 2021 aanwezig is.

 

[HSV]

Hier nog maar een voor alle versies (omdat er hier weinig beleving is).

Private Sub Proces_Change()
Dim sv, sq
With Application
    With Sheets("melding").ListObjects(1).DataBodyRange
      .Columns(3).Name = "b"
       sv = .Value
End With
    sq = Split(Join(Filter(Evaluate("transpose(if(b=""" & Proces & """,row(b)-1,""~""))"), "~", False), "|"), "|")
      If UBound(sq) = -1 Then ListBox1.Clear: Exit Sub
        If UBound(sq) > 0 Then
           ListBox1.List = .Index(sv, .Transpose(sq), Array(1, 2, 3, 4))
         Else
           ListBox1.Column = .Transpose(.Index(sv, .Transpose(sq), Array(1, 2, 3, 4)))
        End If
End With
End Sub

 

[AHulpje]

Nou vooruit, nog eentje dan:

Private Sub proces_Change()
    On Error GoTo ErrHandler

    Dim tbl        As ListObject
    Dim aData      As Variant
    Dim aGefilterd As Variant
    Dim i          As Long
    Dim rTotaal    As Long
    Dim rGevonden  As Long
    Dim r          As Long
    Dim k          As Long

    Set tbl = ThisWorkbook.Sheets("melding").ListObjects("Tabel2")
    aData = tbl.DataBodyRange.Value
    Me.ListBox1.Clear

    ' Tel gevonden aantal om array te dimensioneren: rGevonden
    rTotaal = UBound(aData, 1)
    rGevonden = 0
    For i = 1 To rTotaal
        If aData(i, 3) = Proces.Value Or Proces.Value = "" Then rGevonden = rGevonden + 1
    Next i

    If rGevonden > 0 Then
        ReDim aGefilterd(0 To 3, 0 To rGevonden - 1)
        r = 0
        For i = 1 To rTotaal
            If aData(i, 3) = Proces.Value Or Proces.Value = "" Then
                For k = 0 To 3
                    aGefilterd(k, r) = aData(i, k + 1)
                Next k
                r = r + 1
            End If
        Next i
        Me.ListBox1.Column = aGefilterd
    End If
    Exit Sub

ErrHandler:
    MsgBox "Er is een fout opgetreden: " & vbCrLf & Err.Description
End Sub