Zoek functie excel

[Lindeskote]

Beste Helmij leden,

Voor mijn werk heb ik een excel bestand waarvoor ik een zoekfunctie moet maken. De ideale situatie zou zijn: zoekterm invullen in een tekstvak, op enter drukken, vervolgens worden alle rijen weergeven die de zoekterm bevatten. Het is dus een combinatie van zoeken en filteren.

VB:
Omschrijving - Merk - Model - Bouwjaar - Klant
Split model Mitsubishi fdt100 2013 KPN
Enzovoorts

Zoeken op (bouwjaar) 2013, vervolgens alle regels weergeven die als bouwjaar 2013 hebben, dus tevens met de omschrijving, merk, model etc.


Ik heb al veel codes geprobeerd, die ik gevonden heb op het internet en op dit forum, echter heb ik de goeie nog niet kunnen vinden.
Ik hoop dat jullie mij kunnen helpen!

 

[Lindeskote]

Hier een voorbeeld printscreen, ter verduidelijking

 

[pasan]

kun je hier wat mee?
Zet een ActiveX textbox op je blad en pas het bereik aan

Private Sub TextBox1_Change()
ActiveSheet.Range("$A$2:$F$2").AutoFilter Field:=5, Criteria1:=("*") & TextBox1.Value & ("*")
End Sub

 

[Lindeskote]

Beste Pasan,

Bedankt voor je snelle reactie! Deze oplossing werkt goed wat betreft het zoeken en filteren. Echter wordt er alleen gezocht op de ingestelde kolom (autofilter field). Is er een mogelijkheid dat alle kolommen worden doorzocht/ het autofilter field niet wordt gebruikt?

Groet,
Lindeskote

 

[Lindeskote]

Met een collega heb ik het probleem nu geheel anders opgelost. Met deze code is het mogelijk te zoeken en te filteren tegelijk. Tevens is het met deze code mogelijk om te zoeken in een filter. Bijvoorbeeld eerst filteren op bouwjaar 2013 en vervolgens via de teksbox zoeken naar het gewenste model. Wellicht leuk om te bekijken.

In een blad de volgende code:

Public Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then
Call ww_opheffen
Call Invullen
TextBox1.Activate
Call ww_beveiliging
End If

End Sub

In een andere module vervolgens de code:

Public Sub Invullen()
Application.ScreenUpdating = False
Dim zoeken As Range
Dim EersteRij As Integer
Dim TweedeRij As Integer
Dim EersteKolom As Integer
Dim TweedeKolom As Integer
Dim Rijen As Integer
Dim Kolommen As Integer
Dim Kolom As String
Text = ActiveSheet.TextBox1.Value

'Als er niks is ingevuld stoppen
If Text = "" Then
Exit Sub
End If

'Maakt eerst alles zichtbaar
Rows("3:247").EntireRow.Hidden = False

'telt het aantal rijen in de tabel
Rijen = Range("A" & Rows.Count).End(xlUp).Row
'telt het aantal kolommen in de tabel
Kolommen = Range("2:2" & Columns.Count).End(xlToRight).Column

'Selecteert de EerstRij cel van het zoekbereik
Range("A3").Select

'Begint met zoeken________________________________________________________________________________

With ActiveSheet
Set zoeken = .Cells.Find(What:=Text, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
End With

If zoeken Is Nothing Then 'Als er niks gevonden is, dit melden
Niks = MsgBox("Niets gevonden", vbOKOnly, "Zoeken")
Exit Sub

Else 'Beginnen met selecteren
zoeken.Select
EersteRij = ActiveCell.Row
EersteKolom = ActiveCell.Column
begin = EersteRij - 1
Rows("3" & ":" & begin).EntireRow.Hidden = True
Do
Cells.FindNext(After:=ActiveCell).Activate
TweedeRij = ActiveCell.Row
TweedeKolom = ActiveCell.Column


'functie dat aantal zoekresultaten vergelijkt. als 1 zoekresultaat, dan exit
If (EersteRij = TweedeRij And EersteKolom = TweedeKolom) Or _
(WorksheetFunction.CountIf(Range("A3:N" & Cells(Rijen, Kolommen)), "*" & Text & "*") = 1) _
Then
Exit Do

Else
'Als het zoekbereik opnieuw wordt uitgevoerd
If TweedeRij < EersteRij Then
Exit Do
End If
'De rijen die tussen de eerste en tweede waarde verbergen
If TweedeRij = EersteRij Or TweedeRij = EersteRij + 1 Then

Else
Rows(EersteRij + 1 & ":" & TweedeRij - 1).EntireRow.Hidden = True
End If
End If
EersteRij = TweedeRij
EersteKolom = TweedeKolom
Loop Until IsEmpty(ActiveCell)
End If
'De laatse rijen van de tabel die worden verborgen
einde = EersteRij + 1
Rows(einde & ":" & Rijen).EntireRow.Hidden = True

Range("B2").Select
Application.ScreenUpdating = True
End Sub